home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / rxasyn20.zip / RXSCRIPT.ZIP / RXSCRIPT.CMD < prev    next >
OS/2 REXX Batch file  |  1994-12-31  |  84KB  |  2,065 lines
  1. /*****************************************************************************/
  2. /*                                                                           */
  3. /*  MODULE         RxScript.Cmd                                              */
  4. /*                                                                           */
  5. /*  DESCRIPTION    Perform script processing.                                */
  6. /*                                                                           */
  7. /*  COPYRIGHT      Copyright (C) 1993 - Crucial Applications                 */
  8. /*                            All rights reserved                            */
  9. /*                                                                           */
  10. /*                       Ian Timms - 20th March 1993                         */
  11. /*                                                                           */
  12. /*  NOTES          The following directory layout is used:                   */
  13. /*                                                                           */
  14. /*                 D:\Mail              Home                                 */
  15. /*                 D:\Mail\Bin          DLLs EXEs CMDs                       */
  16. /*                 D:\Mail\Logs         Trace & Log files                    */
  17. /*                 D:\Mail\Scripts      Script files and FREQ lists          */
  18. /*                 D:\Mail\InBox        Inbound mail packets                 */
  19. /*                 D:\Mail\OutBox       Outbound reply packets               */
  20. /*                 D:\Mail\Messages     Mail packets being read              */
  21. /*                 D:\Mail\Replies      Reply packets being built            */
  22. /*                 D:\Mail\SentMail     Processed reply packets              */
  23. /*                                                                           */
  24. /*                 RXASYNC.dll must be located in a directory on the         */
  25. /*                 LIBPATH statement when this utility is invoked or         */
  26. /*                 present in the Bin subdirectory as detailed above.        */
  27. /*                                                                           */
  28. /*  HISTORY                                                                  */
  29. /*                                                                           */
  30. /*    10-Jun-1993  Original release.                                         */
  31. /*                                                                           */
  32. /*  FUTURES        Convert to Exe for faster processing and                  */
  33. /*                 better handling of scripts and coms device.               */
  34. /*                 Add ability to handle mail via CIS. ??? lota work ???     */
  35. /*                                                                           */
  36. /*****************************************************************************/
  37. /* trace('R') */
  38.  
  39.    parse arg Tparms
  40.  
  41.    G.   = ""                           /* Globals                            */
  42.    Dev. = ""                           /* Communications device              */
  43.    Mdm. = ""                           /* Modem definition                   */
  44.    Bbs. = ""                           /* Service definition                 */
  45.  
  46.    G.Parms    = Tparms
  47.  
  48.    call Startup
  49.    if ComConnect( Bbs.Name, Bbs.Phone, Bbs.RetryLimit, Bbs.RetryWait ) then do
  50.       Bbs.Online = time("E")*1000
  51.       call SayLog "Script "Bbs.Script" commenced on "date('N')" at "time('C')"."G.CrLf
  52.  
  53.       /* The script routines have to be internal as REXX can't pass variables to */
  54.       /* an external command file so we just check that the name is correct.     */
  55.       select
  56.         when pos( 'BUNMAIL', translate( Bbs.Script ) ) > 0 then call BunScript
  57.         otherwise nop
  58.       end
  59.  
  60.       call SayLog "Script "Bbs.Script" completed on "date('N')" at "time('C')"."G.CrLf
  61.       call SayLog 'Time online was 'trunc(Bbs.Elapsed/60000)' mins 'trunc((Bbs.Elapsed/10)-(trunc(Bbs.Elapsed/60000)*6000))/100' secs.'G.CrLf
  62.       if ComCarrier() then do
  63.          call ComHangup
  64.       end
  65.    end
  66.    call Cleanup
  67.  
  68. Exit
  69.  
  70. /*****************************************************************************/
  71. /* BUNYIP SCRIPTS ########################################################## */
  72. /*****************************************************************************/
  73.  
  74. BunScript:
  75.    Procedure expose G. Dev. Mdm. Bbs.
  76.    Bbs.Connected = G.True
  77.    if BunLogon() then do
  78.       if \G.FreqOnly then do
  79.          call BunEmail
  80.          /* Get VioDevGrp Next Meeting Notice  */
  81.          if date('W') == 'Monday' then do
  82.             call BunNotice
  83.          end
  84.       end
  85.       if \G.EmailOnly then do
  86.          call BunFiles
  87.       end
  88.       call BunLogoff
  89.    end
  90. Return
  91.  
  92. BunLogon:
  93.    Procedure expose G. Dev. Mdm. Bbs.
  94.    Tlogon = G.False
  95.    Tagain = G.True
  96.    do while Tagain  &  Bbs.Connected
  97.       Tstr = BbsRead()
  98.       select
  99.         when \Bbs.Connected then nop
  100.         when pos( "Sorry, we're not available right now.",    Tstr ) > 0 then Tagain = G.False
  101.         when pos( "Please press your Escape key to enter",    Tstr ) > 0 then call BbsWrite 0, G.Esc||G.Esc
  102.         when pos( "What is your name:",                       Tstr ) > 0 then call BbsWrite 0, Bbs.Userid||G.CtrlM
  103.         when pos( "Your name was not found",                  Tstr ) > 0 then call BbsWrite 2, 'N'
  104.         when pos( Bbs.Userid" [Y,n]?",                        Tstr ) > 0 then call BbsWrite 0, G.CtrlM
  105.         when pos( "Password:",                                Tstr ) > 0 then call BbsWrite 0, Bbs.Password||G.CtrlM
  106.         when pos( "Select Bulletin to view",                  Tstr ) > 0 then call BbsWrite 0, 'B'
  107.         when pos( "Next bulletin [Y,n]",                      Tstr ) > 0 then call BbsWrite 0, 'N'
  108.         when pos( "Do you wish to check for mail",            Tstr ) > 0 then call BbsWrite 0, 'N'
  109.         when pos( "CHAT: start",                              Tstr ) > 0 then call BbsChat
  110.         when pos( "Select:",                                  Tstr ) > 0 then do
  111.                 Tagain = G.False
  112.                 Tlogon = G.True
  113.              end
  114.         otherwise nop
  115.       end
  116.    end
  117. Return Tlogon
  118.  
  119. BunEmail:
  120.    Procedure expose G. Dev. Mdm. Bbs.
  121.    /* Assume we are at the MAIN menu */
  122.    call BbsWrite 0, 'O'                /* Select offline reader              */
  123.    call BbsWaitFor "Select:", 0, 30
  124.    call BunPutMail                     /* Upload any replies from the RepBox */
  125.    call BunGetMail                     /* Download new mail into the PktBox  */
  126.    call BbsWrite 0, 'M'                /* Return to main menu                */
  127.    call BbsWaitFor "Select:", 0, 30
  128. Return
  129.  
  130. BunPutMail:
  131.    Procedure expose G. Dev. Mdm. Bbs.
  132.    Treplnew = G.RepBox||Bbs.Prefix||".REP"
  133.    Treplold = Bbs.Prefix||".OLD"
  134.    if Bbs.Connected then do
  135.       if \RxAsyncFileExists( Bbs.ReplyCheck ) then do
  136.          if RxAsyncFileExists( Treplnew ) then do
  137.             if RxAsyncFileExists( G.RepBox||Treplold ) then
  138.                call SayLog "Unable to upload replies, untossed packet exists."G.CrLf
  139.             else do
  140.                call BbsWrite 0, 'U'
  141.                if \BbsWaitFor( Mdm.AutoUpLoad, 0, 30 ) then
  142.                   call BbsWrite 0, G.CtrlM
  143.                else do
  144.                   if \SendFile( 'Z', Bbs.Baud, Treplnew ) then
  145.                      call BbsWrite 0, G.CtrlM
  146.                   else do
  147.                      call SayLog "Replies have been posted."G.CrLf
  148.                      if \TossPacket( Bbs.Prefix, "REP", G.RepBox, G.SntBox ) then do
  149.                         call RxAsyncFileRename Treplnew Treplold
  150.                      end
  151.                   end
  152.                end
  153.                call BbsWaitFor "Select:", 0, 30
  154.             end
  155.          end
  156.       end
  157.    end
  158. Return
  159.  
  160. BunGetMail:
  161.    Procedure expose G. Dev. Mdm. Bbs.
  162.    Tmailpkt = G.InBox||Bbs.Prefix||".QWK"
  163.    if RxAsyncFileExists( Tmailpkt ) then do
  164.       call TossPacket Bbs.Prefix, "QWK", G.InBox, G.PktBox
  165.    end
  166.    if Bbs.Connected then do
  167.       if RxAsyncFileExists( Tmailpkt ) then
  168.          call SayLog "Unable to download new mail, untossed packet exists."G.CrLf
  169.       else do
  170.          call BbsWrite 0, 'D'
  171.          Tmail = G.False
  172.          Tmore = G.True
  173.          do while Tmore  &  Bbs.Connected
  174.             Tmore = G.False
  175.             Tstr = BbsRead()
  176.             select
  177.               when \Bbs.Connected then nop
  178.               when pos( "CHAT: start",                          Tstr ) > 0 then do
  179.                       call BbsChat
  180.                       call BbsWaitFor "Select:", 0, 30
  181.                       call BbsWrite 0, 'D'
  182.                       Tmore = G.True
  183.                    end
  184.               when pos( "Download these in QWK format",         Tstr ) > 0 then do
  185.                       call BbsWrite 0, G.CtrlM
  186.                       Tmore = G.True
  187.                    end
  188.               when pos( "Error compressing messages.",          Tstr ) > 0 then do
  189.                       call BbsWrite 0, G.CtrlM
  190.                       Tmore = G.True
  191.                    end
  192.               when pos( "Select:",                              Tstr ) > 0 then Tmail = G.False
  193.               when pos( "Hit <enter> (or wait 10 seconds)",     Tstr ) > 0 then Tmail = G.True
  194.               otherwise Tmore = G.True
  195.             end
  196.          end
  197.          if Tmail then do
  198.             call BbsWrite 0, G.CtrlM
  199.             if \BbsWaitFor( Mdm.AutoDnLoad, 0, 30 ) then
  200.                call BbsWrite 0, G.CtrlM
  201.             else do
  202.                if \ReceiveFile( 'Z', Bbs.Baud, Tmailpkt ) then
  203.                   call BbsWrite 0, G.CtrlM
  204.                else do
  205.                   call SayLog "Mail has been collected."G.CrLf
  206.                   call TossPacket Bbs.Prefix, "QWK", G.InBox, G.PktBox
  207.                end
  208.             end
  209.             call BbsWaitFor "Select:", 0, 30
  210.          end
  211.       end
  212.    end
  213. Return
  214.  
  215. BunNotice:
  216.    Procedure expose G. Dev. Mdm. Bbs.
  217.    /* Assume we are at the MAIN menu */
  218.    call BbsWrite 0, 'V'                /* VioDevGrp menu                     */
  219.    call BbsWaitFor "Select:", 0, 30
  220.    call BbsWrite 0, 'N'                /* Next meeting notice                */
  221.    call OpenCap "VioDev.Mtg"
  222.    call BbsWaitFor "Select:", 0, 30
  223.    call CloseCap
  224.    call BbsWrite 0, 'M'                /* Return to main menu                */
  225.    call BbsWaitFor "Select:", 0, 30
  226. Return
  227.  
  228. BunFiles:
  229.    Procedure expose G. Dev. Mdm. Bbs.
  230.    /* Assume we are at the MAIN menu */
  231.    call BbsWrite 0, 'F'                /* Select file menu                   */
  232.    if \BbsWaitFor( "Select:", 0, 30 ) then do
  233.       call BbsWrite 0, 'V'||G.CtrlM    /* VioDevGrp please                   */
  234.       if \BbsWaitFor( "Select:", 0, 30 ) then do
  235.          call BbsWrite 0, 'DEVGRP'||G.CtrlM    /* DevGrp please              */
  236.          if \BbsWaitFor( "Select:", 0, 30 ) then do
  237.             call BbsWrite 0, 'GBETA'||G.CtrlM  /* Guidelines please          */
  238.             call BbsWaitFor "Select:", 0, 30   /* File menu prompt           */
  239.          end
  240.       end
  241.    end
  242.    call BbsWrite 0, 'N'                /* New files scan                     */
  243.    call BbsWaitFor "Date to search from", 0, 30
  244.    call BbsWrite 0, G.CtrlM            /* Since last connect                 */
  245.    call OpenCap "BunFile.New"
  246.    call BbsWaitFor "Select:", 0, 300   /* Allow 5 minutes tops               */
  247.    call CloseCap
  248.    call BunPutFile                     /* Upload specified files             */
  249.    call BunGetFile                     /* Download specified files           */
  250. Return
  251.  
  252. BunPutFile:
  253.    Procedure expose G. Dev. Mdm. Bbs.
  254.    if Bbs.Connected then do
  255.       Told = "SendFile.Old"
  256.       Tnew = "SendFile.New"
  257.       if \RxAsyncFileRename( G.ScrPath||G.SndFile, Told ) then
  258.          call SayLog "Unable to rename '"G.ScrPath||G.SndFile"' to '"Told"'."G.CrLf
  259.       else do
  260.          Tcount = 0
  261.          do while lines( G.ScrPath||Told ) > 0
  262.             Tspec = linein( G.ScrPath||Told )
  263.             select
  264.                when \Bbs.Connected then nop
  265.                when substr(Tspec,1,1) == '#' then nop
  266.                when Tcount >= Bbs.MaxUpload then nop
  267.                when (pos( Bbs.Prefix, Tspec ) > 0) | (substr(Tspec,1,1) == '*') then do
  268.                        if BunSndFile( Tspec ) then do
  269.                           if substr(Tspec,1,1) == '*' then
  270.                              call lineout G.ScrPath||Tnew, "# Uploaded on "date('N')" at "time('C')": "Bbs.Prefix" "substr(Tspec,3)
  271.                           else do
  272.                              Tspec = "# Uploaded on "date('N')" at "time('C')": "Tspec
  273.                           end
  274.                           Tcount = Tcount + 1
  275.                        end
  276.                     end
  277.                otherwise nop
  278.             end
  279.             call lineout G.ScrPath||Tnew, Tspec
  280.          end
  281.          call lineout G.ScrPath||Tnew
  282.          call lineout G.ScrPath||Told
  283.          if RxAsyncFileRename( G.ScrPath||Tnew, G.SndFile ) then
  284.             call RxAsyncFileDelete G.ScrPath||Told
  285.          else do
  286.             call SayLog "Unable to rename '"G.ScrPath||Tnew"' to '"G.SndFile"'."G.CrLf
  287.          end
  288.       end
  289.    end
  290. Return
  291.  
  292. BunSndFile:
  293.    Procedure expose G. Dev. Mdm. Bbs.
  294.    parse arg Tfspec
  295.    parse var Tfspec Tbbs Tarea Tfname Tdesc
  296.    Tfile = G.False
  297.    if length( Tfname ) > 0 then do
  298.       /* default file path if not specified */
  299.       Tdir  = RxAsyncFilePathIs( Tfname )
  300.       Tname = RxAsyncFileNameIs( Tfname )
  301.       if length( Tdir ) = 0 then do
  302.          Tdir = G.OutBox
  303.       end
  304.       Tfname = Tdir||Tname
  305.       if \RxAsyncFileExists( Tfname ) then
  306.          call SayLog "Unable to upload '"Tfname"', file not found."G.CrLf
  307.       else do
  308.          /* change file area if required */
  309.          if substr(Tarea,1,1) \= '*' then nop    /* not implemented yet */
  310.          /* check for file on BBS */
  311.          call BbsWrite 0, 'L'
  312.          call BbsWaitFor "Enter the text to find:", 0, 30
  313.          call BbsWrite 0, Tname||G.CtrlM
  314.          Tfind = G.True
  315.          Tmore = G.True
  316.          do while Tmore  &  Bbs.Connected
  317.             Tstr = BbsRead()
  318.             select
  319.               when \Bbs.Connected then nop
  320.               when pos( "CHAT: start",             Tstr ) > 0 then do
  321.                       call BbsChat
  322.                       call BbsWaitFor "Select:", 0, 30
  323.                       call BbsWrite 0, 'L'
  324.                       call BbsWaitFor "Enter the text to find:", 0, 30
  325.                       call BbsWrite 0, Tname||G.CtrlM
  326.                    end
  327.               when pos( "Located 0 matches.",      Tstr ) > 0 then Tfind = G.False
  328.               when pos( "Select:",                 Tstr ) > 0 then Tmore = G.False
  329.               otherwise nop
  330.             end
  331.          end
  332.          if Bbs.Connected  &  \Tfind then do
  333.             /* upload file */
  334.             call BbsWrite 0, 'U'
  335.             if \BbsWaitFor( Mdm.AutoUpLoad, 0, 30 ) then
  336.                call BbsWrite 0, G.CtrlM
  337.             else do
  338.                if \SendFile( 'Z', Bbs.Baud, Tfname ) then
  339.                   call BbsWrite 0, G.CtrlM
  340.                else do
  341.                   Tfile = G.True
  342.                   /* fill in the description */
  343.                   Tlin = 1
  344.                   call BbsWaitFor D2C(Tlin+48)||'>', 0, 30
  345.                   Tdsc = ""
  346.                   Tnum = 0
  347.                   Tcnt = words( Tdesc )
  348.                   do while Tnum < Tcnt  &  Tlin < 4  &  Bbs.Connected
  349.                      Tnum = Tnum + 1
  350.                      Twrd = word( Tdesc, Tnum )
  351.                      if length( Tdsc' 'Twrd ) < 45 then
  352.                         Tdsc = Tdsc' 'Twrd
  353.                      else do
  354.                         Tlin = Tlin + 1
  355.                         call BbsWrite 0, substr(Tdsc,2)||G.CtrlM
  356.                         call BbsWaitFor D2C(Tlin+48)||'>', 0, 30
  357.                         Tdsc = ' 'Twrd
  358.                      end
  359.                      if Tnum = Tcnt then do
  360.                         Tlin = Tlin + 1
  361.                         call BbsWrite 0, substr(Tdsc,2)||G.CtrlM
  362.                         call BbsWaitFor D2C(Tlin+48)||'>', 0, 30
  363.                      end
  364.                   end
  365.                   call BbsWrite 0, G.CtrlM
  366.                end
  367.             end
  368.             call BbsWaitFor "Select:", 0, 30
  369.          end
  370.       end
  371.    end
  372. Return Tfile
  373.  
  374. BunGetFile:
  375.    Procedure expose G. Dev. Mdm. Bbs.
  376.    if Bbs.Connected then do
  377.       Told = "FreqFile.Old"
  378.       Tnew = "FreqFile.New"
  379.       if \RxAsyncFileRename( G.ScrPath||G.FrqFile, Told ) then
  380.          call SayLog "Unable to rename '"G.ScrPath||G.FrqFile"' to '"Told"'."G.CrLf
  381.       else do
  382.          Tcount = 0
  383.          do while lines( G.ScrPath||Told ) > 0
  384.             Tspec = linein( G.ScrPath||Told )
  385.             select
  386.                when \Bbs.Connected then nop
  387.                when substr(Tspec,1,1) == '#' then nop
  388.                when Tcount >= Bbs.MaxDnload then nop
  389.                when (pos( Bbs.Prefix, Tspec ) > 0) | (substr(Tspec,1,1) == '*') then do
  390.                        if BunRcvFile( Tspec ) then do
  391.                           if substr(Tspec,1,1) == '*' then
  392.                              Tspec = "# Downloaded on "date('N')" at "time('C')": "Bbs.Prefix" "substr(Tspec,3)
  393.                           else do
  394.                              Tspec = "# Downloaded on "date('N')" at "time('C')": "Tspec
  395.                           end
  396.                           Tcount = Tcount + 1
  397.                        end
  398.                     end
  399.                otherwise nop
  400.             end
  401.             call lineout G.ScrPath||Tnew, Tspec
  402.          end
  403.          call lineout G.ScrPath||Tnew
  404.          call lineout G.ScrPath||Told
  405.          if RxAsyncFileRename( G.ScrPath||Tnew, G.FrqFile ) then
  406.             call RxAsyncFileDelete G.ScrPath||Told
  407.          else do
  408.             call SayLog "Unable to rename '"G.ScrPath||Tnew"' to '"G.FrqFile"'."G.CrLf
  409.          end
  410.       end
  411.    end
  412. Return
  413.  
  414. BunRcvFile:
  415.    Procedure expose G. Dev. Mdm. Bbs.
  416.    parse arg Tfspec
  417.    parse var Tfspec Tbbs Tarea Tfname Tfdest
  418.    Tfile = G.False
  419.    if length( Tfname ) > 0 then do
  420.       /* source file spec */
  421.       Tname = RxAsyncFileNameIs( Tfname )
  422.       /* destination file spec */
  423.       Tfdestdir  = ''
  424.       Tfdestname = ''
  425.       if length( Tfdest ) > 0 then do
  426.          Tfdestdir  = RxAsyncFilePathIs( Tfdest )
  427.          Tfdestname = RxAsyncFileNameIs( Tfdest )
  428.       end
  429.       /* default to source name if no target name specified */
  430.       if length( Tfdestname ) = 0 then do
  431.          Tfdestname = Tname
  432.       end
  433.       /* default to inbox if no target directory specified */
  434.       if length( Tfdestdir ) = 0 then do
  435.          Tfdestdir = G.InBox
  436.       end
  437.       Tfdest = Tfdestdir||Tfdestname
  438.       /* check existence */
  439.       if RxAsyncFileExists( Tfdest ) then do
  440.          call SayLog "Unable to download to '"Tfdest"', file already exists."G.CrLf
  441.          Tfile = G.True
  442.       end; else do
  443.          /* change file area if required */
  444.          if substr(Tarea,1,1) \= '*' then nop /* not implemented yet */
  445.          /* check for file on BBS */
  446.          call BbsWrite 0, 'L'
  447.          call BbsWaitFor "Enter the text to find:", 0, 30
  448.          call BbsWrite 0, Tname||G.CtrlM
  449.          Tfind = G.True
  450.          Tmore = G.True
  451.          do while Tmore  &  Bbs.Connected
  452.             Tstr = BbsRead()
  453.             select
  454.               when \Bbs.Connected then nop
  455.               when pos( "CHAT: start",             Tstr ) > 0 then do
  456.                       call BbsChat
  457.                       call BbsWaitFor "Select:", 0, 30
  458.                       call BbsWrite 0, 'L'
  459.                       call BbsWaitFor "Enter the text to find:", 0, 30
  460.                       call BbsWrite 0, Tname||G.CtrlM
  461.                    end
  462.               when pos( "Located 0 matches.",      Tstr ) > 0 then Tfind = G.False
  463.               when pos( "Select:",                 Tstr ) > 0 then Tmore = G.False
  464.               otherwise nop
  465.             end
  466.          end
  467.          if Bbs.Connected  &  Tfind then do
  468.             /* download file */
  469.             call BbsWrite 0, 'D'
  470.             call BbsWaitFor "File(s) to download ", 0, 30
  471.             call BbsWrite 0, Tname||G.CtrlM
  472.             if \BbsWaitFor( "File(s) to download", 0, 30 ) then
  473.                call BbsWrite 0, G.CtrlM
  474.             else do
  475.                call BbsWrite 0, G.CtrlM
  476.                if \BbsWaitFor( Mdm.AutoDnLoad, 0, 30 ) then
  477.                   call BbsWrite 0, G.CtrlM
  478.                else do
  479.                   if \ReceiveFile( 'Z', Bbs.Baud, Tfdest ) then
  480.                      call BbsWrite 0, G.CtrlM
  481.                   else do
  482.                      Tfile = G.True
  483.                   end
  484.                end
  485.             end
  486.             call BbsWaitFor "Select:", 0, 30
  487.          end
  488.       end
  489.    end
  490. Return Tfile
  491.  
  492. BunLogoff:
  493.    Procedure expose G. Dev. Mdm. Bbs.
  494.    call BbsWrite 0, 'G'
  495.    call BbsWaitFor "Disconnect [Y,n,?=help]", 0, 30
  496.    call BbsWrite 0, G.CtrlM
  497.    call BbsWaitFor "Leave a message to", 0, 30
  498.    call BbsWrite 0, G.CtrlM
  499.    call BbsWaitFor "You have uploaded", 0, 30
  500. Return
  501.  
  502. /*****************************************************************************/
  503. /* SCRIPT SUPPORT ROUTINES ################################################# */
  504. /*****************************************************************************/
  505.  
  506. BbsWrite:                              /* write string to BBS                */
  507.    Procedure expose G. Dev. Mdm. Bbs.
  508.    parse arg Twait, Tstring
  509.    if Bbs.Connected then do
  510.       Twait = Twait * 1000             /* convert to milliseconds */
  511.       call ComWrite Twait, Tstring
  512.    end
  513. Return
  514.  
  515. BbsChat:                               /* handle chat interruption by sysop  */
  516.    Procedure expose G. Dev. Mdm. Bbs.
  517.    /* found a "CHAT: start" so tell the sysop to POQ */
  518.    call OpenCap "BbsChat.Cap"
  519.    call BbsWrite 0, "WARNING: You are attempting to chat with an automated service!"||G.CtrlM
  520.    call BbsWrite 0, G.CtrlM
  521.    call BbsWrite 0, "  Your comments will be logged but cannot be responded to at"||G.CtrlM
  522.    call BbsWrite 0, "  this time.  Execution of this service should resume as soon"||G.CtrlM
  523.    call BbsWrite 0, "  as chat mode is terminated."||G.CtrlM
  524.    call BbsWrite 0, G.CtrlM
  525.    call BbsWrite 0, "Thanks for dropping in.<g>"||G.CtrlM
  526.    call BbsWrite 0, G.CtrlM
  527.    call BbsWaitFor "CHAT: end", 0, 120
  528.    call CloseCap
  529.    /* found a "CHAT: end" so return to doing what we came here to do */
  530. Return
  531.  
  532. BbsRead:                               /* read string from BBS               */
  533.    Procedure expose G. Dev. Mdm. Bbs.
  534.    Tstr = ""
  535.    Tagain = G.True
  536.    do while Tagain & Bbs.Connected
  537.       Tstr = ComRead()
  538.       Bbs.Connected = ComCarrier()
  539.       if Bbs.Connected then do
  540.          Bbs.Elapsed = (time("E")*1000) - Bbs.Online
  541.          select
  542.            when Bbs.Elapsed >= Bbs.OnTimeout then do
  543.                    call SayLog "Closing connection, time limit exceeded."G.CrLf
  544.                    call ComHangup         /* Terminate connection               */
  545.                    Bbs.Connected = G.False
  546.                    Tagain = G.False
  547.                 end
  548.            when pos( "--More--",                Tstr ) > 0 then call BbsWrite 0, ' '
  549.            when pos( "Press ENTER to continue", Tstr ) > 0 then call BbsWrite 0, G.CtrlM
  550.            when pos( "More [Y,n,=]?",           Tstr ) > 0 then call BbsWrite 0, G.CtrlM
  551.            when pos( "More [Y,n,t,=]?",         Tstr ) > 0 then call BbsWrite 0, G.CtrlM
  552.            when length( Tstr ) > 0 then Tagain = G.False
  553.            otherwise nop
  554.          end
  555.       end
  556.    end
  557. Return Tstr
  558.  
  559. BbsWaitFor:                            /* wait for specified string          */
  560.    Procedure expose G. Dev. Mdm. Bbs.
  561.    parse arg Twaitstr, Tstrpos, Tmaxwait
  562.    Tstr = ""
  563.    Tbegun = time("E")*1000
  564.    Tfound = G.False
  565.    Tagain = G.True
  566.    do while Tagain & Bbs.Connected
  567.       Tstr = ComRead()
  568.       Bbs.Connected = ComCarrier()
  569.       if Bbs.Connected then do
  570.          Bbs.Elapsed = (time("E")*1000) - Bbs.Online
  571.          Twaited = (time("E")*1000) - Tbegun
  572.          select
  573.            when Bbs.Elapsed >= Bbs.OnTimeout then do
  574.                    call SayLog "Closing connection, time limit exceeded."G.CrLf
  575.                    call ComHangup         /* Terminate connection               */
  576.                    Bbs.Connected = G.False
  577.                    Tagain = G.False
  578.                 end
  579.            when (Tstrpos = 0) & (pos( Twaitstr, Tstr ) > 0) then do
  580.                    Tfound = G.True
  581.                    Tagain = G.False
  582.                 end
  583.            when (Tstrpos > 0) & (pos( Twaitstr, Tstr ) = Tstrpos) then do
  584.                    Tfound = G.True
  585.                    Tagain = G.False
  586.                 end
  587.            when pos( "--More--",                Tstr ) > 0 then call BbsWrite 0, ' '
  588.            when pos( "Press ENTER to continue", Tstr ) > 0 then call BbsWrite 0, G.CtrlM
  589.            when pos( "More [Y,n,=]?",           Tstr ) > 0 then call BbsWrite 0, G.CtrlM
  590.            when pos( "More [Y,n,t,=]?",         Tstr ) > 0 then call BbsWrite 0, G.CtrlM
  591.            when (Tmaxwait >= 0)  &  (Twaited >= (Tmaxwait*1000)) then Tagain = G.False
  592.            otherwise nop
  593.          end
  594.       end
  595.    end
  596. Return Tfound
  597.  
  598. /*****************************************************************************/
  599. /* EMAIL SUPPORT ROUTINES ################################################## */
  600. /*****************************************************************************/
  601.  
  602. TossPacket:
  603.    Procedure expose G. Dev. Mdm. Bbs.
  604.    parse arg PktPfx, PktType, PktFrom, PktTo
  605.    Tossed = G.False
  606.    Ttmp = G.HomeDir||"RxScript.Tmp"
  607.    Tnum = 0
  608.    "@FF "PktTo" "PktPfx"."substr(PktType,1,1)"?? | SORT >"Ttmp
  609.    if RC = 0 then do
  610.       do while lines( Ttmp ) > 0
  611.          Tstr = linein( Ttmp )
  612.          Tval = X2D( right( Tstr, 2, '0' ) )
  613.          if Tval > Tnum then Tnum = Tval
  614.       end
  615.       call lineout Ttmp
  616.    end
  617.    call RxAsyncFileDelete Ttmp
  618.    Tnum = Tnum + 1
  619.    if Tnum > 255 then do     /* (ie. FF) */
  620.       Tnum = 1               /* (ie. 01) */
  621.    end
  622.    OldPkt = PktFrom||PktPfx||"."||PktType
  623.    NewPkt = PktTo||PktPfx||"."||substr(PktType,1,1)||D2X(Tnum,2)
  624.    Tossed = RxAsyncFileMove( OldPkt, NewPkt )
  625.    if \Tossed then
  626.       call SayLog "Unable to toss '"OldPkt"' to '"NewPkt"'. Archive NOW!"G.CrLf
  627.    else do
  628.       if PktType == "REP" then do     /* only for reply packets */
  629.          "@pkunzip -o "||NewPkt||" "||PktTo||" "||PktPfx||".MSG"
  630.          "@"||G.PrgPath||"rep2txt "||PktTo||PktPfx||".MSG "||PktTo||"SentMail.Txt"
  631.          "@del "||PktTo||PktPfx||".MSG"
  632.       end
  633.    end
  634. Return Tossed
  635.  
  636. /*****************************************************************************/
  637. /* INITIALISATION AND SHUTDOWN ROUTINES #################################### */
  638. /*****************************************************************************/
  639.  
  640. Startup:                               /* Perform initialisation routines    */
  641.    Procedure expose G. Dev. Mdm. Bbs.
  642.    call FncLoad
  643.    call InitGlb
  644.    call GetParm
  645.    call OpenTrc
  646.    call OpenLog
  647.    call InitProt
  648.    call PrepDev
  649.    call PrepMdm
  650.    call PrepBbs
  651.    call ComOpen
  652.    call ComInitialise Bbs.Baud, Bbs.Parity, Bbs.Data, Bbs.Stop
  653. Return
  654.  
  655. Cleanup:                               /* Cleanup prior to exit              */
  656.    Procedure expose G. Dev. Mdm. Bbs.
  657.    call ComClose
  658.    call FiniProt
  659.    call CloseBbs
  660.    call CloseMdm
  661.    call CloseDev
  662.    call CloseCap
  663.    call CloseLog
  664.    call CloseTrc
  665.    call FreeGlb
  666.    call FncDrop
  667. Return
  668.  
  669. FncLoad:                               /* Register functions with rexx       */
  670.    Procedure expose G. Dev. Mdm. Bbs.
  671.    Dev.Load = G.True
  672.    call RxFuncAdd 'RxAsyncLoadFuncs', 'RXASYNC', 'RxAsyncLoadFuncs'
  673.    zx = RxAsyncLoadFuncs()             /* Load RXASYNC.dll functions         */
  674.    say 'RxAsyncLoadFuncs returned rc='zx
  675.    signal on error name FncFatal
  676. Return
  677.  
  678. FncDrop:                               /* Deregister externalised functions  */
  679.    Procedure expose G. Dev. Mdm. Bbs.
  680.    if Dev.Load then do
  681.       Dev.Load = G.False               /* Prevent repeated call              */
  682.       zx = RxAsyncDropFuncs()          /* Drop RXASYNC.dll functions         */
  683.       say 'RxAsyncDropFuncs returned rc='zx
  684.    end
  685. Return
  686.  
  687. FncFatal:                              /* Handle serious errors              */
  688.    Procedure expose G. Dev. Mdm. Bbs.
  689.    if Dev.Hdl > 0 then do
  690.       call RxAsyncClose Dev.Hdl
  691.    end
  692.    exit
  693. Return
  694.  
  695. InitGlb:                               /* Initialise global variables        */
  696.    Procedure expose G. Dev. Mdm. Bbs.
  697.  
  698.    G.SaveDir  = RxAsyncDirectory()     /* Save so that we can return to it   */
  699.  
  700.    /* Install should place an entry in OS2.INI which tells RXSCRIPT where it */
  701.    /* has been installed, thus this routine can then query and set HomeDir.  */
  702.    /* This requires install script to prompt for destination directory with  */
  703.    /* default of "C:\Mail\" and insert an entry into OS2.INI then copy the   */
  704.    /* files and creating directories and desktop objects required.           */
  705.    /* An uninstall script to delete the OS2.INI entry then prompt for        */
  706.    /* removal of all files, directories and desktop objects.                 */
  707.  
  708.    /* In the meantime we hard code the home directory here.                  */
  709.    G.HomeDir  = "D:\Mail\"             /* Home, home on the range.......     */
  710.  
  711.    /* General */
  712.    G.True      = 1
  713.    G.False     = 0
  714.    G.Esc       = D2C(27)
  715.    G.CtrlM     = D2C(13)
  716.    G.CtrlX     = D2C(24)
  717.    G.CrLf      = D2C(13)||D2C(10)
  718.    G.NoEcho    = G.True
  719.    G.Quietly   = G.False
  720.    G.EmailOnly = G.False
  721.    G.FreqOnly  = G.False
  722.    G.Abort     = G.False
  723.  
  724.    /* Default paths */
  725.    G.PrgPath  = G.HomeDir||"Bin\"      /* Programs and configuration files   */
  726.    G.LogPath  = G.HomeDir||"Logs\"     /* log and trace files                */
  727.    G.ScrPath  = G.HomeDir||"Scripts\"  /* script files                       */
  728.    G.InBox    = G.HomeDir||"InBox\"    /* inbound file and mail area         */
  729.    G.OutBox   = G.HomeDir||"OutBox\"   /* outbound file and mail area        */
  730.    G.PktBox   = G.HomeDir||"Messages\" /* message packet reading area        */
  731.    G.RepBox   = G.HomeDir||"Replies\"  /* reply packet creation area         */
  732.    G.SntBox   = G.HomeDir||"SentMail\" /* processed replies                  */
  733.  
  734.    /* Default files names */
  735.    G.SndFile  = "RxScript.Put"         /* default upload list file name      */
  736.    G.FrqFile  = "RxScript.Get"         /* default download list file name    */
  737.    G.TrcFile  = "RxScript.Trc"         /* default trace file name            */
  738.    G.LogFile  = "RxScript.Log"         /* default log file name              */
  739.    G.XfrFile  = "RxScript.Xfr"         /* default up/down load log name      */
  740.    G.DevFile  = "RxScript.Dev"         /* default device file name           */
  741.    G.MdmFile  = "RxScript.Mdm"         /* default modem file name            */
  742.    G.BbsFile  = ""                     /* default bbs file name              */
  743.    G.ScrFile  = ""                     /* default script file name           */
  744.    G.CapFile  = ""                     /* default capture file name          */
  745.  
  746.    /* Used by trace routines */
  747.    G.WantTrc  = G.False
  748.    G.TrcOpen  = G.False
  749.  
  750.    /* Used by logging routines */
  751.    G.WantLog  = G.False
  752.    G.LogOpen  = G.False
  753.  
  754.    /* Used by capture routines */
  755.    G.CapOpen  = G.False
  756.  
  757.    /* Used by external protocol routines */
  758.    G.ProtIni  = G.False
  759.    G.OldPath  = ""
  760.    G.OldDpath = ""
  761.    G.NewPath  = ""
  762.    G.NewDpath = ""
  763.  
  764.    /* Status of definition files */
  765.    Dev.Open   = G.False
  766.    Mdm.Open   = G.False
  767.    Bbs.Open   = G.False
  768.  
  769.    call RxAsyncDirectory G.PrgPath     /* Relocate to program directory      */
  770. Return
  771.  
  772. FreeGlb:                               /* Release global variables           */
  773.    Procedure expose G. Dev. Mdm. Bbs.
  774.    call RxAsyncDirectory G.SaveDir     /* return to original location        */
  775. Return
  776.  
  777. GetParm:                               /* Get and validate parameters        */
  778.    Procedure expose G. Dev. Mdm. Bbs.
  779.    Tparm = G.Parms
  780.    do while length(Tparm) > 0
  781.       parse var Tparm Tparm Trest
  782.       Tparm = strip( Tparm, 'B', ' ' )
  783.       Toptn = translate( substr(Tparm,1,2) )
  784.       Tvalu = substr(Tparm,3)
  785.       Tvallen = length( Tvalu )
  786.       Tnamlen = 0
  787.       if Tvallen > 0 then do
  788.          Tnamlen = length( RxAsyncFileNameIs( Tvalu ) )
  789.       end
  790.       select
  791.         when Toptn == "-B" then do
  792.                 select
  793.                   when Tvallen = 0 then
  794.                        call Abort "GetParm: Option -b specified without BBS definition file name."
  795.                   when Tnamlen = 0 then
  796.                        call Abort "GetParm: Option -b specified invalid BBS definition file name."
  797.                   otherwise
  798.                        G.BbsFile = Tvalu
  799.                 end
  800.              end
  801.         when Toptn == "-D" then do
  802.                 select
  803.                   when Tvallen = 0 then
  804.                        call Abort "GetParm: Option -d specified without device definition file name."
  805.                   when Tnamlen = 0 then
  806.                        call Abort "GetParm: Option -d specified invalid device definition file name."
  807.                   otherwise
  808.                        G.DevFile = Tvalu
  809.                 end
  810.              end
  811.         when Toptn == "-E" then do
  812.                 G.EmailOnly = G.True
  813.              end
  814.         when Toptn == "-F" then do
  815.                 G.FreqOnly = G.True
  816.              end
  817.         when Toptn == "-L" then do
  818.                 G.WantLog = G.True
  819.                 select
  820.                   when Tvallen = 0 then
  821.                        nop
  822.                   when Tnamlen = 0 then
  823.                        call Abort "GetParm: Option -l specified invalid log file name."
  824.                   otherwise
  825.                        G.LogFile = Tvalu
  826.                 end
  827.              end
  828.         when Toptn == "-M" then do
  829.                 select
  830.                   when Tvallen = 0 then
  831.                        call Abort "GetParm: Option -m specified without modem definition file name."
  832.                   when Tnamlen = 0 then
  833.                        call Abort "GetParm: Option -m specified invalid modem definition file name."
  834.                   otherwise
  835.                        G.MdmFile = Tvalu
  836.                 end
  837.              end
  838.         when Toptn == "-Q" then do
  839.                 G.Quietly = G.True
  840.              end
  841.         when Toptn == "-S" then do
  842.                 select
  843.                   when Tvallen = 0 then
  844.                        call Abort "GetParm: Option -s specified without script file name."
  845.                   when Tnamlen = 0 then
  846.                        call Abort "GetParm: Option -s specified invalid script file name."
  847.                   otherwise
  848.                        G.ScrFile = Tvalu
  849.                 end
  850.              end
  851.         when Toptn == "-T" then do
  852.                 G.WantTrc = G.True
  853.                 select
  854.                   when Tvallen = 0 then
  855.                        nop
  856.                   when Tnamlen = 0 then
  857.                        call Abort "GetParm: Option -t specified invalid trace file name."
  858.                   otherwise
  859.                        G.TrcFile = Tvalu
  860.                 end
  861.              end
  862.         when Toptn == "-X" then do
  863.                 select
  864.                   when Tvallen = 0 then
  865.                        call Abort "GetParm: Option -x specified without transfer log file name."
  866.                   when Tnamlen = 0 then
  867.                        call Abort "GetParm: Option -x specified invalid transfer log file name."
  868.                   otherwise
  869.                        G.XfrFile = Tvalu
  870.                 end
  871.              end
  872.         otherwise nop
  873.       end
  874.       Tparm = Trest
  875.    end
  876.    /* Default to looking in program path for DEV file if not specified */
  877.    if RxAsyncFilePathIs( G.DevFile ) == "" then do
  878.       G.DevFile = G.PrgPath||G.DevFile
  879.    end
  880.    /* Default to looking in log path for LOG file if not specified */
  881.    if RxAsyncFilePathIs( G.LogFile ) == "" then do
  882.       G.LogFile = G.LogPath||G.LogFile
  883.    end
  884.    /* Default to looking in program path for MDM file if not specified */
  885.    if RxAsyncFilePathIs( G.MdmFile ) == "" then do
  886.       G.MdmFile = G.PrgPath||G.MdmFile
  887.    end
  888.    /* Default to looking in script path for BBS file if not specified */
  889.    if RxAsyncFilePathIs( G.BbsFile ) == "" then do
  890.       G.BbsFile = G.ScrPath||G.BbsFile
  891.    end
  892.    /* Default to looking in log path for TRC file if not specified */
  893.    if RxAsyncFilePathIs( G.TrcFile ) == "" then do
  894.       G.TrcFile = G.LogPath||G.TrcFile
  895.    end
  896.    /* Default to looking in log path for XFR file if not specified */
  897.    if RxAsyncFilePathIs( G.XfrFile ) == "" then do
  898.       G.XfrFile = G.LogPath||G.XfrFile
  899.    end
  900. Return
  901.  
  902. /*****************************************************************************/
  903. /* BBS DEFINITION ROUTINES ################################################# */
  904. /*****************************************************************************/
  905.  
  906. PrepBbs:                               /* Initialise bbs definitions         */
  907.    Procedure expose G. Dev. Mdm. Bbs.
  908.    call InitBbsVar
  909.    call OpenBbs
  910.    call ReadBbs
  911.    call CloseBbs
  912.    call ChkBbsVar
  913. Return
  914.  
  915. InitBbsVar:                            /* Initialise global bbs variables    */
  916.    Procedure expose G. Dev. Mdm. Bbs.
  917.    Bbs.Name       = ""
  918.    Bbs.Prefix     = ""
  919.    Bbs.Sysop      = ""
  920.    Bbs.Phone      = ""
  921.    Bbs.HostId     = ""
  922.    Bbs.Script     = ""
  923.    Bbs.Userid     = ""
  924.    Bbs.Password   = ""
  925.    Bbs.Baud       = Dev.Baud
  926.    Bbs.Parity     = Dev.Parity
  927.    Bbs.Data       = Dev.Data
  928.    Bbs.Stop       = Dev.Stop
  929.    Bbs.OnTimeout  = 3600*1000          /* 60 minutes */
  930.    Bbs.RetryWait  = 300*1000           /* 5 minutes */
  931.    Bbs.RetryLimit = 5                  /* 5 times */
  932.    Bbs.FileArea   = "1"
  933.    Bbs.FtpStatus  = "Yes"
  934.    Bbs.MaxUpload  = 10
  935.    Bbs.MaxDnload  = 20
  936.    Bbs.ReplyCheck = ""
  937.    Bbs.Online     = 0
  938.    Bbs.Elapsed    = 0
  939.    Bbs.Connected  = G.False
  940. Return
  941.  
  942. OpenBbs:                               /* Open bbs definition file           */
  943.    Procedure expose G. Dev. Mdm. Bbs.
  944.    Bbs.Open = G.False
  945.    if RxAsyncFileExists( G.BbsFile ) then
  946.       call SayMsg "Loading BBS definition from file '"G.BbsFile"'."G.CrLf
  947.    else do
  948.       call Abort "OpenBbs: Could not open BBS definition file '"G.BbsFile"'."
  949.    end
  950.    Tstr = linein( G.BbsFile, 1, 0 )
  951.    if Tstr \== "" then do
  952.       call Abort "OpenBbs: Could not open BBS definition file '"G.BbsFile"'."
  953.    end
  954.    Bbs.Open = G.True
  955. Return
  956.  
  957. ReadBbs:                               /* Process bbs definition file        */
  958.    Procedure expose G. Dev. Mdm. Bbs.
  959.    if Bbs.Open then do
  960.       do while lines( G.BbsFile ) > 0
  961.          Tstr = linein( G.BbsFile )
  962.          Tstr = strip( Tstr, 'B', ' ' )
  963.          if length( Tstr ) > 0 then do
  964.             if substr( Tstr, 1, 1 ) <> '#' then do
  965.                parse var Tstr Tkey Tval
  966.                call SetBbsVar Tkey, Tval
  967.             end
  968.          end
  969.       end
  970.    end
  971. Return
  972.  
  973. CloseBbs:                              /* Close bbs defintion file           */
  974.    Procedure expose G. Dev. Mdm. Bbs.
  975.    if Bbs.Open then do
  976.       Bbs.Open = G.False               /* Prevent repeated call              */
  977.       Trxc = lineout( G.BbsFile )
  978.       if Trxc <> 0 then do
  979.          call Abort "CloseBbs: Could not close BBS definition file '"G.BbsFile"'."
  980.       end
  981.    end
  982. Return
  983.  
  984. ChkBbsVar:                             /* Validate bbs definitions           */
  985.    Procedure expose G. Dev. Mdm. Bbs.
  986.    if length( G.ScrFile ) > 0 then do
  987.       Bbs.Script = G.ScrFile
  988.    end
  989.    Tscrpath = RxAsyncFilePathIs( Bbs.Script )
  990.    Tscrname = RxAsyncFileNameIs( Bbs.Script )
  991.    if Tscrpath == "" then do
  992.       Bbs.Script = G.ScrPath||Bbs.Script
  993.    end
  994.    if Bbs.Prefix     == "" then call Abort "ChkBbsVar: BBS definition 'Prefix:' not specified."
  995.    if Bbs.Phone      == "" then call Abort "ChkBbsVar: BBS definition 'PhoneNumber:' not specified."
  996.    if Bbs.Userid     == "" then call Abort "ChkBbsVar: BBS definition 'Userid:' not specified."
  997.    if Bbs.Password   == "" then call Abort "ChkBbsVar: BBS definition 'Password:' not specified."
  998.    if Tscrname       == "" then call Abort "ChkBbsVar: BBS definition 'Script:' not specified."
  999.    if Bbs.ReplyCheck == "" then call Abort "ChkBbsVar: BBS definition 'ReplyCheck:' not specified."
  1000.  
  1001.    /* if \RxAsyncFileExists( Bbs.Script ) then do                             */
  1002.    /*    call Abort "ChkBbsVar: Could not find script file '"Bbs.Script"'."   */
  1003.    /* end                                                                     */
  1004.    /*                                                                         */
  1005.    /* The script routines have to be internal as REXX can't pass variables to */
  1006.    /* an external command file so we'll just assume that the name is correct. */
  1007. Return
  1008.  
  1009. SetBbsVar:                             /* Set global bbs variables           */
  1010.    Procedure expose G. Dev. Mdm. Bbs.
  1011.    parse arg Tkey, Tval
  1012.    Tkey = strip( Tkey, 'B', ' ' )
  1013.    Tval = strip( Tval, 'B', ' ' )
  1014.    Tchk = translate( Tkey )            /* Convert to uppercase for testing   */
  1015.    Tval = ChkDefVal( Tkey, Tval )      /* Resolve any ^M sequences           */
  1016.    call TrcMsg Tkey||' '||Tval
  1017.    select
  1018.      when Tchk == "NAME:"                         then Bbs.Name       = Tval
  1019.      when Tchk == "PREFIX:"         & Tval \== "" then Bbs.Prefix     = Tval
  1020.      when Tchk == "SYSOP:"                        then Bbs.Sysop      = Tval
  1021.      when Tchk == "PHONENUMBER:"    & Tval \== "" then Bbs.Phone      = Tval
  1022.      when Tchk == "HOSTNETID:"      & Tval \== "" then Bbs.HostId     = Tval
  1023.      when Tchk == "SCRIPT:"         & Tval \== "" then Bbs.Script     = Tval
  1024.      when Tchk == "USERID:"         & Tval \== "" then Bbs.Userid     = Tval
  1025.      when Tchk == "PASSWORD:"       & Tval \== "" then Bbs.Password   = Tval
  1026.      when Tchk == "BAUDRATE:"       & Tval \== "" then Bbs.Baud       = Tval
  1027.      when Tchk == "PARITY:"         & Tval \== "" then Bbs.Parity     = Tval
  1028.      when Tchk == "DATABITS:"       & Tval \== "" then Bbs.Data       = Tval
  1029.      when Tchk == "STOPBITS:"       & Tval \== "" then Bbs.Stop       = Tval
  1030.      when Tchk == "ONLINETIMEOUT:"  & Tval \== "" then Bbs.OnTimeout  = Tval*1000
  1031.      when Tchk == "RETRYWAIT:"      & Tval \== "" then Bbs.RetryWait  = Tval*1000
  1032.      when Tchk == "RETRYLIMIT:"     & Tval \== "" then Bbs.RetryLimit = Tval
  1033.      when Tchk == "DEFFILEAREA:"                  then Bbs.FileArea   = Tval
  1034.      when Tchk == "SHOWFTPSTATUS:"  & Tval \== "" then Bbs.FtpStatus  = Tval
  1035.      when Tchk == "MAXUPLOAD:"      & Tval \== "" then Bbs.MaxUpload  = Tval
  1036.      when Tchk == "MAXDOWNLOAD:"    & Tval \== "" then Bbs.MaxDnload  = Tval
  1037.      when Tchk == "REPLYCHECK:"     & Tval \== "" then Bbs.ReplyCheck = Tval
  1038.      otherwise
  1039.           call Abort "SetBbsVar: Bad BBS definition entry. Key='"Tkey"', Value='"Tval"'."
  1040.    end
  1041. Return
  1042.  
  1043. /*****************************************************************************/
  1044. /* MODEM DEFINITION ROUTINES ############################################### */
  1045. /*****************************************************************************/
  1046.  
  1047. PrepMdm:                               /* Initialise modem definitions       */
  1048.    Procedure expose G. Dev. Mdm. Bbs.
  1049.    call InitMdmVar
  1050.    call OpenMdm
  1051.    call ReadMdm
  1052.    call CloseMdm
  1053.    call ChkMdmVar
  1054. Return
  1055.  
  1056. InitMdmVar:                            /* Initialise global modem variables  */
  1057.    Procedure expose G. Dev. Mdm. Bbs.
  1058.    Mdm.Name       = "Generic"
  1059.    Mdm.ConTimeout = 45*1000              /* 45 seconds */
  1060.    Mdm.AutoDnLoad = G.CtrlX||"B00"
  1061.    Mdm.AutoUpLoad = G.CtrlX||"B01"
  1062.    Mdm.Enter      = G.CtrlM
  1063.    Mdm.Reset      = "ATZ"
  1064.    Mdm.Break      = "+++~~~+++"
  1065.    Mdm.DialPrefix = "ATDT"
  1066.    Mdm.DialSuffix = G.CtrlM
  1067.    Mdm.Online     = "ATO"
  1068.    Mdm.Hangup     = "ATH0"
  1069.    Mdm.Okay       = "OK"
  1070.    Mdm.Error      = "ERROR"
  1071.    Mdm.NoCarrier  = "NO CARRIER"
  1072.    Mdm.InitStr0   = "ATE0Q0V1X1&C1&D2"
  1073.    Mdm.InitStr1   = ""
  1074.    Mdm.InitStr2   = ""
  1075.    Mdm.InitStr3   = ""
  1076.    Mdm.InitStr4   = ""
  1077.    Mdm.InitStr5   = ""
  1078.    Mdm.InitStr6   = ""
  1079.    Mdm.InitStr7   = ""
  1080.    Mdm.InitStr8   = ""
  1081.    Mdm.InitStr9   = ""
  1082.    Mdm.Connect0   = "CONNECT"
  1083.    Mdm.Connect1   = ""
  1084.    Mdm.Connect2   = ""
  1085.    Mdm.Connect3   = ""
  1086.    Mdm.Connect4   = ""
  1087.    Mdm.Connect5   = ""
  1088.    Mdm.Connect6   = ""
  1089.    Mdm.Connect7   = ""
  1090.    Mdm.Connect8   = ""
  1091.    Mdm.Connect9   = ""
  1092.    Mdm.NoConnect0 = "NO CARRIER"
  1093.    Mdm.NoConnect1 = ""
  1094.    Mdm.NoConnect2 = ""
  1095.    Mdm.NoConnect3 = ""
  1096.    Mdm.NoConnect4 = ""
  1097.    Mdm.NoConnect5 = ""
  1098.    Mdm.NoConnect6 = ""
  1099.    Mdm.NoConnect7 = ""
  1100.    Mdm.NoConnect8 = ""
  1101.    Mdm.NoConnect9 = ""
  1102. Return
  1103.  
  1104. OpenMdm:                               /* Open modem definition file         */
  1105.    Procedure expose G. Dev. Mdm. Bbs.
  1106.    Mdm.Open = G.False
  1107.    if RxAsyncFileExists( G.MdmFile ) then
  1108.       call SayMsg "Loading modem definition from file '"G.MdmFile"'."G.CrLf
  1109.    else do
  1110.       call Abort "OpenMdm: Could not open modem definition file '"G.MdmFile"'."
  1111.    end
  1112.    Tstr = linein( G.MdmFile, 1, 0 )
  1113.    if Tstr \== "" then do
  1114.       call Abort "OpenMdm: Could not open modem definition file '"G.MdmFile"'."
  1115.    end
  1116.    Mdm.Open = G.True
  1117. Return
  1118.  
  1119. ReadMdm:                               /* Process modem definition file      */
  1120.    Procedure expose G. Dev. Mdm. Bbs.
  1121.    if Mdm.Open then do
  1122.       do while lines( G.MdmFile ) > 0
  1123.          Tstr = linein( G.MdmFile )
  1124.          Tstr = strip( Tstr, 'B', ' ' )
  1125.          if length( Tstr ) > 0 then do
  1126.             if substr( Tstr, 1, 1 ) <> '#' then do
  1127.                parse var Tstr Tkey Tval
  1128.                call SetMdmVar Tkey, Tval
  1129.             end
  1130.          end
  1131.       end
  1132.    end
  1133. Return
  1134.  
  1135. CloseMdm:                              /* Close modem defintion file         */
  1136.    Procedure expose G. Dev. Mdm. Bbs.
  1137.    if Mdm.Open then do
  1138.       Mdm.Open = G.False               /* Prevent repeated call              */
  1139.       Trxc = lineout( G.MdmFile )
  1140.       if Trxc <> 0 then do
  1141.          call Abort "CloseMdm: Could not close modem definition file '"G.MdmFile"'."
  1142.       end
  1143.    end
  1144. Return
  1145.  
  1146. ChkMdmVar:                             /* Validate modem definitions         */
  1147.    Procedure expose G. Dev. Mdm. Bbs.
  1148.    /* do nothing stub */
  1149.    nop
  1150. Return
  1151.  
  1152. SetMdmVar:                             /* Set global modem variables         */
  1153.    Procedure expose G. Dev. Mdm. Bbs.
  1154.    parse arg Tkey, Tval
  1155.    Tkey = strip( Tkey, 'B', ' ' )
  1156.    Tval = strip( Tval, 'B', ' ' )
  1157.    Tchk = translate( Tkey )            /* Convert to uppercase for testing   */
  1158.    Tval = ChkDefVal( Tkey, Tval )      /* Resolve any ^M sequences           */
  1159.    call TrcMsg Tkey||' '||Tval
  1160.    select
  1161.      when Tchk == "NAME:"                         then Mdm.Name       = Tval
  1162.      when Tchk == "CONNECTTIMEOUT:" & Tval \== "" then Mdm.ConTimeout = Tval*1000
  1163.      when Tchk == "AUTODNLOAD:"     & Tval \== "" then Mdm.AutoDnLoad = Tval
  1164.      when Tchk == "AUTOUPLOAD:"     & Tval \== "" then Mdm.AutoUpLoad = Tval
  1165.      when Tchk == "ENTER:"          & Tval \== "" then Mdm.Enter      = Tval
  1166.      when Tchk == "RESET:"          & Tval \== "" then Mdm.Reset      = Tval
  1167.      when Tchk == "BREAK:"                        then Mdm.Break      = Tval
  1168.      when Tchk == "DIALPREFIX:"     & Tval \== "" then Mdm.DialPrefix = Tval
  1169.      when Tchk == "DIALSUFFIX:"     & Tval \== "" then Mdm.DialSuffix = Tval
  1170.      when Tchk == "ONLINE:"                       then Mdm.Online     = Tval
  1171.      when Tchk == "HANGUP:"                       then Mdm.Hangup     = Tval
  1172.      when Tchk == "OKAY:"           & Tval \== "" then Mdm.Okay       = Tval
  1173.      when Tchk == "ERROR:"          & Tval \== "" then Mdm.Error      = Tval
  1174.      when Tchk == "NOCARRIER:"      & Tval \== "" then Mdm.NoCarrier  = Tval
  1175.      when Tchk == "INITSTR0:"                     then Mdm.InitStr0   = Tval
  1176.      when Tchk == "INITSTR1:"                     then Mdm.InitStr1   = Tval
  1177.      when Tchk == "INITSTR2:"                     then Mdm.InitStr2   = Tval
  1178.      when Tchk == "INITSTR3:"                     then Mdm.InitStr3   = Tval
  1179.      when Tchk == "INITSTR4:"                     then Mdm.InitStr4   = Tval
  1180.      when Tchk == "INITSTR5:"                     then Mdm.InitStr5   = Tval
  1181.      when Tchk == "INITSTR6:"                     then Mdm.InitStr6   = Tval
  1182.      when Tchk == "INITSTR7:"                     then Mdm.InitStr7   = Tval
  1183.      when Tchk == "INITSTR8:"                     then Mdm.InitStr8   = Tval
  1184.      when Tchk == "INITSTR9:"                     then Mdm.InitStr9   = Tval
  1185.      when Tchk == "CONNECT0:"       & Tval \== "" then Mdm.Connect0   = Tval
  1186.      when Tchk == "CONNECT1:"                     then Mdm.Connect1   = Tval
  1187.      when Tchk == "CONNECT2:"                     then Mdm.Connect2   = Tval
  1188.      when Tchk == "CONNECT3:"                     then Mdm.Connect3   = Tval
  1189.      when Tchk == "CONNECT4:"                     then Mdm.Connect4   = Tval
  1190.      when Tchk == "CONNECT5:"                     then Mdm.Connect5   = Tval
  1191.      when Tchk == "CONNECT6:"                     then Mdm.Connect6   = Tval
  1192.      when Tchk == "CONNECT7:"                     then Mdm.Connect7   = Tval
  1193.      when Tchk == "CONNECT8:"                     then Mdm.Connect8   = Tval
  1194.      when Tchk == "CONNECT9:"                     then Mdm.Connect9   = Tval
  1195.      when Tchk == "NOCONNECT0:"     & Tval \== "" then Mdm.NoConnect0 = Tval
  1196.      when Tchk == "NOCONNECT1:"                   then Mdm.NoConnect1 = Tval
  1197.      when Tchk == "NOCONNECT2:"                   then Mdm.NoConnect2 = Tval
  1198.      when Tchk == "NOCONNECT3:"                   then Mdm.NoConnect3 = Tval
  1199.      when Tchk == "NOCONNECT4:"                   then Mdm.NoConnect4 = Tval
  1200.      when Tchk == "NOCONNECT5:"                   then Mdm.NoConnect5 = Tval
  1201.      when Tchk == "NOCONNECT6:"                   then Mdm.NoConnect6 = Tval
  1202.      when Tchk == "NOCONNECT7:"                   then Mdm.NoConnect7 = Tval
  1203.      when Tchk == "NOCONNECT8:"                   then Mdm.NoConnect8 = Tval
  1204.      when Tchk == "NOCONNECT9:"                   then Mdm.NoConnect9 = Tval
  1205.      otherwise
  1206.           call Abort "SetMdmVar: Bad modem definition entry. Key='"Tkey"', Value='"Tval"'."
  1207.    end
  1208. Return
  1209.  
  1210. /*****************************************************************************/
  1211. /* COMMUNICATIONS DEFINITION ROUTINES ###################################### */
  1212. /*****************************************************************************/
  1213.  
  1214. PrepDev:                               /* Initialise comms port definitions  */
  1215.    Procedure expose G. Dev. Mdm. Bbs.
  1216.    call InitDevVar
  1217.    call OpenDev
  1218.    call ReadDev
  1219.    call CloseDev
  1220.    call ChkDevVar
  1221. Return
  1222.  
  1223. InitDevVar:                            /* Initialise global comms variables  */
  1224.    Procedure expose G. Dev. Mdm. Bbs.
  1225.    Dev.Load      = G.False
  1226.    Dev.Carrier   = G.False
  1227.    Dev.Hdl       = 0
  1228.    Dev.PollTime  = 2000                /* milliseconds */
  1229.    Dev.Port      = "COM2"
  1230.    Dev.Baud      = 1200
  1231.    Dev.Parity    = 'N'
  1232.    Dev.Data      = 8
  1233.    Dev.Stop      = 1
  1234.    Dev.WTimeout  = 50                  /* hundredths */
  1235.    Dev.RTimeout  = 50                  /* hundredths */
  1236.    Dev.DcbFlags1 = "00001001"
  1237.    Dev.DcbFlags2 = "10100000"
  1238.    Dev.DcbFlags3 = "11010010"
  1239.    Dev.ErrorChar = "00"
  1240.    Dev.BreakChar = "00"
  1241.    Dev.XonChar   = "11"
  1242.    Dev.XoffChar  = "13"
  1243.    Dev.EnhParms  = "00000010"
  1244.    Dev.OldBaud   = 0
  1245.    Dev.OldData   = 0
  1246.    Dev.OldParity = ''
  1247.    Dev.OldStop   = 0
  1248.    Dev.OldWtime  = 0
  1249.    Dev.OldRtime  = 0
  1250.    Dev.OldFlag1  = ""
  1251.    Dev.OldFlag2  = ""
  1252.    Dev.OldFlag3  = ""
  1253.    Dev.OldErrCh  = ""
  1254.    Dev.OldBrkCh  = ""
  1255.    Dev.OldXonCh  = ""
  1256.    Dev.OldXofCh  = ""
  1257.    Dev.OldEnPrm  = ""
  1258. Return
  1259.  
  1260. OpenDev:                               /* Open com definition file           */
  1261.    Procedure expose G. Dev. Mdm. Bbs.
  1262.    Dev.Open = G.False
  1263.    if RxAsyncFileExists( G.DevFile ) then
  1264.       call SayMsg "Loading device definition from file '"G.DevFile"'."G.CrLf
  1265.    else do
  1266.       call Abort "OpenDev: Could not open device definition file '"G.DevFile"'."
  1267.    end
  1268.    Tstr = linein( G.DevFile, 1, 0 )
  1269.    if Tstr \== "" then do
  1270.       call Abort "OpenDev: Could not open device definition file '"G.DevFile"'."
  1271.    end
  1272.    Dev.Open = G.True
  1273. Return
  1274.  
  1275. ReadDev:                               /* Process com definition file        */
  1276.    Procedure expose G. Dev. Mdm. Bbs.
  1277.    if Dev.Open then do
  1278.       do while lines( G.DevFile ) > 0
  1279.          Tstr = linein( G.DevFile )
  1280.          Tstr = strip( Tstr, 'B', ' ' )
  1281.          if length( Tstr ) > 0 then do
  1282.             if substr( Tstr, 1, 1 ) <> '#' then do
  1283.                parse var Tstr Tkey Tval
  1284.                call SetDevVar Tkey, Tval
  1285.             end
  1286.          end
  1287.       end
  1288.    end
  1289. Return
  1290.  
  1291. CloseDev:                              /* Close com defintion file           */
  1292.    Procedure expose G. Dev. Mdm. Bbs.
  1293.    if Dev.Open then do
  1294.       Dev.Open = G.False               /* Prevent repeated call              */
  1295.       Trxc = lineout( G.DevFile )
  1296.       if Trxc <> 0 then do
  1297.          call Abort "CloseDev: Could not close device definition file '"G.DevFile"'."
  1298.       end
  1299.    end
  1300. Return
  1301.  
  1302. ChkDevVar:                             /* Validate device definitions        */
  1303.    Procedure expose G. Dev. Mdm. Bbs.
  1304.    /* do nothing stub */
  1305.    nop
  1306. Return
  1307.  
  1308. SetDevVar:                             /* Set global com variables           */
  1309.    Procedure expose G. Dev. Mdm. Bbs.
  1310.    parse arg Tkey, Tval
  1311.    Tkey = strip( Tkey, 'B', ' ' )
  1312.    Tval = strip( Tval, 'B', ' ' )
  1313.    Tchk = translate( Tkey )            /* Convert to uppercase for testing   */
  1314.    Tval = ChkDefVal( Tkey, Tval )      /* Resolve any ^M sequences           */
  1315.    call TrcMsg Tkey||' '||Tval
  1316.    select
  1317.      when Tchk == "PORT:"           & Tval \== "" then Dev.Port       = Tval
  1318.      when Tchk == "POLLTIMEOUT:"    & Tval \== "" then Dev.PollTime   = Tval
  1319.      when Tchk == "BAUDRATE:"       & Tval \== "" then Dev.Baud       = Tval
  1320.      when Tchk == "PARITY:"         & Tval \== "" then Dev.Parity     = Tval
  1321.      when Tchk == "DATABITS:"       & Tval \== "" then Dev.Data       = Tval
  1322.      when Tchk == "STOPBITS:"       & Tval \== "" then Dev.Stop       = Tval
  1323.      when Tchk == "WRITETIMEOUT:"   & Tval \== "" then Dev.WTimeout   = Tval
  1324.      when Tchk == "READTIMEOUT:"    & Tval \== "" then Dev.RTimeout   = Tval
  1325.      when Tchk == "DCBFLAGS1:"      & Tval \== "" then Dev.DcbFlags1  = Tval
  1326.      when Tchk == "DCBFLAGS2:"      & Tval \== "" then Dev.DcbFlags2  = Tval
  1327.      when Tchk == "DCBFLAGS3:"      & Tval \== "" then Dev.DcbFlags3  = Tval
  1328.      when Tchk == "ERRORCHAR:"      & Tval \== "" then Dev.ErrorChar  = Tval
  1329.      when Tchk == "BREAKCHAR:"      & Tval \== "" then Dev.BreakChar  = Tval
  1330.      when Tchk == "XONCHAR:"        & Tval \== "" then Dev.XonChar    = Tval
  1331.      when Tchk == "XOFFCHAR:"       & Tval \== "" then Dev.XoffChar   = Tval
  1332.      when Tchk == "ENHANCEDPARMS:"  & Tval \== "" then Dev.EnhParms   = Tval
  1333.      otherwise
  1334.           call Abort "SetDevVar: Bad device definition entry. Key='"Tkey"', Value='"Tval"'."
  1335.    end
  1336. Return
  1337.  
  1338. /*****************************************************************************/
  1339. /* DEFINITION FILE ROUTINES ################################################ */
  1340. /*****************************************************************************/
  1341.  
  1342. ChkDefVal:                             /* Resolve control sequences          */
  1343.    Procedure expose G. Dev. Mdm. Bbs.
  1344.    parse arg ChkKey, ChkVal
  1345.    ChkFin = G.False
  1346.    ChkNew = ""
  1347.    ChkRem = ChkVal
  1348.    do until ChkFin
  1349.       ChkPos = pos( '^', ChkRem )
  1350.       ChkLen = length( ChkRem )
  1351.       if ChkPos > 0 then do
  1352.          if ChkPos = ChkLen then
  1353.             call Abort "ChkDefVal: Unexpected end of definition entry, Key='"ChkKey"', Value='"ChkVal"'."
  1354.          else do
  1355.             if ChkPos > 1 then do
  1356.                ChkNew = ChkNew||substr( ChkRem, 1, ChkPos-1 )
  1357.             end
  1358.             CtlChr = substr( ChkRem, ChkPos+1, 1 )
  1359.             if CtlChr == '^' then
  1360.                ChkNew = ChkNew||CtlChr
  1361.             else do
  1362.                CtlChr = translate( CtlChr )
  1363.                CtlInd = pos( CtlChr, "ABCDEFGHIJKLMNOPQRSTUVWXYZ[" )
  1364.                if CtlInd > 0 then
  1365.                   ChkNew = ChkNew||D2C(CtlInd)
  1366.                else do
  1367.                   call Abort "ChkDefVal: Invalid definition entry, Key='"ChkKey"', Value='"ChkVal"'."
  1368.                end
  1369.             end
  1370.             if ChkPos+2 > ChkLen then
  1371.                ChkFin = G.True
  1372.             else do
  1373.                ChkRem = substr( ChkRem, ChkPos+2, ChkLen-(ChkPos+1) )
  1374.             end
  1375.          end
  1376.       end; else do
  1377.          ChkFin = G.True
  1378.          ChkNew = ChkNew||ChkRem
  1379.       end
  1380.    end
  1381. Return ChkNew
  1382.  
  1383. /*****************************************************************************/
  1384. /* COMMUNICATIONS DEVICE ROUTINES ########################################## */
  1385. /*****************************************************************************/
  1386.  
  1387. ComOpen:                               /* Open communications device         */
  1388.    Procedure expose G. Dev. Mdm. Bbs.
  1389.    Dev.Hdl = 0
  1390.    Tdev = Dev.Hdl
  1391.    Trxc = RxAsyncOpen( Dev.Port, "Tdev" )
  1392.    if Trxc <> 0 then do
  1393.       call Abort "ComOpen: RxAsyncOpen failed, Rc='"Trxc"'."
  1394.    end
  1395.    Dev.Hdl = Tdev
  1396.    call TrcMsg "RxAsyncOpen opened port '"Dev.Port"', Handle='"Dev.Hdl"'."
  1397.    call ComPriority 3, 0
  1398.    call ComSave
  1399. Return
  1400.  
  1401. ComClose:                              /* Close communications device        */
  1402.    Procedure expose G. Dev. Mdm. Bbs.
  1403.    if Dev.Hdl > 0 then do
  1404.       call ComRestore
  1405.       call ComPriority 2, 0
  1406.       Tdev = Dev.Hdl
  1407.       Dev.Hdl = 0                      /* Prevent repeated call              */
  1408.       Trxc = RxAsyncClose( Tdev )
  1409.       if Trxc <> 0 then do
  1410.          call Abort "ComClose: RxAsyncClose failed, Rc='"Trxc"'."
  1411.       end
  1412.       call TrcMsg "RxAsyncClose closed the device."
  1413.    end
  1414. Return
  1415.  
  1416. ComSave:                               /* Save original settings             */
  1417.    Procedure expose G. Dev. Mdm. Bbs.
  1418.    /* line control */
  1419.    Tbaud   = 0
  1420.    Tdata   = 0
  1421.    Tparity = ''
  1422.    Tstop   = 0
  1423.    Trxc = RxAsyncGetLnCtrl( Dev.Hdl, 'Tbaud', 'Tdata', 'Tparity', 'Tstop' )
  1424.    if Trxc <> 0 then do
  1425.       call Abort "ComSave: RxAsyncGetLnCtrl failed, Rc='"Trxc"'."
  1426.    end
  1427.    Dev.OldBaud   = Tbaud
  1428.    Dev.OldData   = Tdata
  1429.    Dev.OldParity = Tparity
  1430.    Dev.OldStop   = Tstop
  1431.    call TrcMsg "RxAsyncGetLnCtrl has saved the original settings."
  1432.    call TrcMsg "  Baudrate was >"Dev.OldBaud"<"
  1433.    call TrcMsg "  Parity   was >"Dev.OldParity"<"
  1434.    call TrcMsg "  Databits was >"Dev.OldData"<"
  1435.    call TrcMsg "  Stopbits was >"Dev.OldStop"<"
  1436.    /* dcb info */
  1437.    TWtime  = 0
  1438.    TRtime  = 0
  1439.    TFlag1  = ""
  1440.    TFlag2  = ""
  1441.    TFlag3  = ""
  1442.    TErrCh  = ""
  1443.    TBrkCh  = ""
  1444.    TXonCh  = ""
  1445.    TXofCh  = ""
  1446.    Trxc = RxAsyncGetDcbInfo( Dev.Hdl, 'TWtime', 'TRtime', 'TFlag1', 'TFlag2', 'TFlag3', 'TErrCh', 'TBrkCh', 'TXonCh', 'TXofCh' )
  1447.    if Trxc <> 0 then do
  1448.       call Abort "ComSave: RxAsyncGetDcbInfo failed, Rc='"Trxc"'."
  1449.    end
  1450.    Dev.OldWtime  = TWtime
  1451.    Dev.OldRtime  = TRtime
  1452.    Dev.OldFlag1  = X2B(TFlag1)
  1453.    Dev.OldFlag2  = X2B(TFlag2)
  1454.    Dev.OldFlag3  = X2B(TFlag3)
  1455.    Dev.OldErrCh  = TErrCh
  1456.    Dev.OldBrkCh  = TBrkCh
  1457.    Dev.OldXonCh  = TXonCh
  1458.    Dev.OldXofCh  = TXofCh
  1459.    call TrcMsg "RxAsyncGetDcbInfo has saved the original settings."
  1460.    call TrcMsg "  Write Timeout  was >"Dev.OldWtime"<"
  1461.    call TrcMsg "  Read  Timeout  was >"Dev.OldRtime"<"
  1462.    call TrcMsg "  F1 HandShake   was >"Dev.OldFlag1"<"
  1463.    call TrcMsg "  F2 FlowReplace was >"Dev.OldFlag2"<"
  1464.    call TrcMsg "  F3 Timeout     was >"Dev.OldFlag3"<"
  1465.    call TrcMsg "  Error Replace  was >"Dev.OldErrCh"<"
  1466.    call TrcMsg "  Break Replace  was >"Dev.OldBrkCh"<"
  1467.    call TrcMsg "  Xon character  was >"Dev.OldXonCh"<"
  1468.    call TrcMsg "  Xoff character was >"Dev.OldXofCh"<"
  1469.    /* enhanced parms */
  1470.    TEnPrm  = ""
  1471.    Trxc = RxAsyncGetEnhParm( Dev.Hdl, 'TEnPrm' )
  1472.    if Trxc <> 0 then do
  1473.       call Abort "ComSave: RxAsyncGetEnhParm failed, Rc='"Trxc"'."
  1474.    end
  1475.    Dev.OldEnPrm  = X2B(TEnPrm)
  1476.    call TrcMsg "RxAsyncGetEnhParm has saved the original settings."
  1477.    call TrcMsg "  Enhanced Parms was >"Dev.OldEnPrm"<"
  1478. Return
  1479.  
  1480. ComRestore:                            /* Restore original settings          */
  1481.    Procedure expose G. Dev. Mdm. Bbs.
  1482.    /* enhanced parms */
  1483.    Trxc = RxAsyncSetEnhParm( Dev.Hdl, Dev.OldEnPrm )
  1484.    if Trxc <> 0 then do
  1485.       call Abort "ComRestore: RxAsyncSetEnhParm failed, Rc='"Trxc"'."
  1486.    end
  1487.    call TrcMsg "RxAsyncSetEnhParm has restored the original settings."
  1488.    /* dcb info */
  1489.    Trxc = RxAsyncSetDcbInfo( Dev.Hdl, Dev.OldWtime, Dev.OldRtime, Dev.OldFlag1, Dev.OldFlag2, Dev.OldFlag3, Dev.OldErrCh, Dev.OldBrkCh, Dev.OldXonCh, Dev.OldXofCh )
  1490.    if Trxc <> 0 then do
  1491.       call Abort "ComRestore: RxAsyncSetDcbInfo failed, Rc='"Trxc"'."
  1492.    end
  1493.    call TrcMsg "RxAsyncSetDcbInfo has restored the original settings."
  1494.    /* line control */
  1495.    Trxc = RxAsyncSetLnCtrl( Dev.Hdl, Dev.OldBaud, Dev.OldData, Dev.OldParity, Dev.OldStop )
  1496.    if Trxc <> 0 then do
  1497.       call Abort "ComRestore: RxAsyncSetLnCtrl failed, Rc='"Trxc"'."
  1498.    end
  1499.    call TrcMsg "RxAsyncSetLnCtrl has restored the original settings."
  1500. Return
  1501.  
  1502. ComInitialise:                         /* Set communications device parms    */
  1503.    Procedure expose G. Dev. Mdm. Bbs.
  1504.    parse arg Tbaud, Tparity, Tdata, Tstop
  1505.    /* line control */
  1506.    Trxc = RxAsyncSetLnCtrl( Dev.Hdl, Tbaud, Tdata, Tparity, Tstop )
  1507.    if Trxc <> 0 then do
  1508.       call Abort "ComInitialise: RxAsyncSetLnCtrl failed, Rc='"Trxc"'."
  1509.    end
  1510.    call TrcMsg "RxAsyncSetLnCtrl has set the required settings."
  1511.    call TrcMsg "  Baudrate now >"Tbaud"<"
  1512.    call TrcMsg "  Parity   now >"Tparity"<"
  1513.    call TrcMsg "  Databits now >"Tdata"<"
  1514.    call TrcMsg "  Stopbits now >"Tstop"<"
  1515.    /* dcb info */
  1516.    Trxc = RxAsyncSetDcbInfo( Dev.Hdl, Dev.WTimeout, Dev.RTimeout, Dev.DcbFlags1, Dev.DcbFlags2, Dev.DcbFlags3, Dev.ErrorChar, Dev.BreakChar, Dev.XonChar, Dev.XoffChar )
  1517.    if Trxc <> 0 then do
  1518.       call Abort "ComInitialise: RxAsyncSetDcbInfo failed, Rc='"Trxc"'."
  1519.    end
  1520.    call TrcMsg "RxAsyncSetDcbInfo has set the required settings."
  1521.    call TrcMsg "  Write Timeout  now >"Dev.WTimeout"<"
  1522.    call TrcMsg "  Read  Timeout  now >"Dev.RTimeout"<"
  1523.    call TrcMsg "  F1 HandShake   now >"Dev.DcbFlags1"<"
  1524.    call TrcMsg "  F2 FlowReplace now >"Dev.DcbFlags2"<"
  1525.    call TrcMsg "  F3 Timeout     now >"Dev.DcbFlags3"<"
  1526.    call TrcMsg "  Error Replace  now >"Dev.ErrorChar"<"
  1527.    call TrcMsg "  Break Replace  now >"Dev.BreakChar"<"
  1528.    call TrcMsg "  Xon character  now >"Dev.XonChar"<"
  1529.    call TrcMsg "  Xoff character now >"Dev.XoffChar"<"
  1530.    /* enhanced parms */
  1531.    Trxc = RxAsyncSetEnhParm( Dev.Hdl, Dev.EnhParms )
  1532.    if Trxc <> 0 then do
  1533.       call Abort "ComInitialise: RxAsyncSetEnhParms failed, Rc='"Trxc"'."
  1534.    end
  1535.    call TrcMsg "RxAsyncSetEnhParms has set the required settings."
  1536.    call TrcMsg "  Enhanced Parms now >"Dev.EnhParms"<"
  1537.    /* modem */
  1538.    Tstr = ComSuck()
  1539.    call TrcMsg "Resetting"
  1540.    call ComWrite 0, Mdm.Reset||Mdm.Enter
  1541.    Tstr = ComSuck()
  1542.    if pos( Mdm.Okay, Tstr ) = 0 then do
  1543.       call Abort "ComInitialise: Unable to reset modem, possibly switched off."
  1544.    end
  1545.    call TrcMsg "Initialising"
  1546.    if length( Mdm.InitStr0 ) > 0 then do
  1547.       call ComWrite 0, Mdm.InitStr0||Mdm.Enter
  1548.       Tstr = ComSuck()
  1549.       if pos( Mdm.Okay, Tstr ) = 0 then do
  1550.          call Abort "ComInitialise: Unable to init0 modem, possibly switched off."
  1551.       end
  1552.    end
  1553.    if length( Mdm.InitStr1 ) > 0 then do
  1554.       call ComWrite 0, Mdm.InitStr1||Mdm.Enter
  1555.       Tstr = ComSuck()
  1556.       if pos( Mdm.Okay, Tstr ) = 0 then do
  1557.          call Abort "ComInitialise: Unable to init1 modem, possibly switched off."
  1558.       end
  1559.    end
  1560.    if length( Mdm.InitStr2 ) > 0 then do
  1561.       call ComWrite 0, Mdm.InitStr2||Mdm.Enter
  1562.       Tstr = ComSuck()
  1563.       if pos( Mdm.Okay, Tstr ) = 0 then do
  1564.          call Abort "ComInitialise: Unable to init2 modem, possibly switched off."
  1565.       end
  1566.    end
  1567.    if length( Mdm.InitStr3 ) > 0 then do
  1568.       call ComWrite 0, Mdm.InitStr3||Mdm.Enter
  1569.       Tstr = ComSuck()
  1570.       if pos( Mdm.Okay, Tstr ) = 0 then do
  1571.          call Abort "ComInitialise: Unable to init3 modem, possibly switched off."
  1572.       end
  1573.    end
  1574.    if length( Mdm.InitStr4 ) > 0 then do
  1575.       call ComWrite 0, Mdm.InitStr4||Mdm.Enter
  1576.       Tstr = ComSuck()
  1577.       if pos( Mdm.Okay, Tstr ) = 0 then do
  1578.          call Abort "ComInitialise: Unable to init4 modem, possibly switched off."
  1579.       end
  1580.    end
  1581.    if length( Mdm.InitStr5 ) > 0 then do
  1582.       call ComWrite 0, Mdm.InitStr5||Mdm.Enter
  1583.       Tstr = ComSuck()
  1584.       if pos( Mdm.Okay, Tstr ) = 0 then do
  1585.          call Abort "ComInitialise: Unable to init5 modem, possibly switched off."
  1586.       end
  1587.    end
  1588.    if length( Mdm.InitStr6 ) > 0 then do
  1589.       call ComWrite 0, Mdm.InitStr6||Mdm.Enter
  1590.       Tstr = ComSuck()
  1591.       if pos( Mdm.Okay, Tstr ) = 0 then do
  1592.          call Abort "ComInitialise: Unable to init6 modem, possibly switched off."
  1593.       end
  1594.    end
  1595.    if length( Mdm.InitStr7 ) > 0 then do
  1596.       call ComWrite 0, Mdm.InitStr7||Mdm.Enter
  1597.       Tstr = ComSuck()
  1598.       if pos( Mdm.Okay, Tstr ) = 0 then do
  1599.          call Abort "ComInitialise: Unable to init7 modem, possibly switched off."
  1600.       end
  1601.    end
  1602.    if length( Mdm.InitStr8 ) > 0 then do
  1603.       call ComWrite 0, Mdm.InitStr8||Mdm.Enter
  1604.       Tstr = ComSuck()
  1605.       if pos( Mdm.Okay, Tstr ) = 0 then do
  1606.          call Abort "ComInitialise: Unable to init8 modem, possibly switched off."
  1607.       end
  1608.    end
  1609.    if length( Mdm.InitStr9 ) > 0 then do
  1610.       call ComWrite 0, Mdm.InitStr9||Mdm.Enter
  1611.       Tstr = ComSuck()
  1612.       if pos( Mdm.Okay, Tstr ) = 0 then do
  1613.          call Abort "ComInitialise: Unable to init9 modem, possibly switched off."
  1614.       end
  1615.    end
  1616. Return
  1617.  
  1618. ComRead:                               /* Read from communications device    */
  1619.    Procedure expose G. Dev. Mdm. Bbs.
  1620.    Tstr = ""
  1621.    Trxc = RxAsyncRead( Dev.Hdl, 0, Dev.PollTime, "Tstr", "" )
  1622.    if Trxc > 0 then do
  1623.       call Abort "ComRead: RxAsyncRead failed, Rc='"Trxc"', Str='"Tstr"'."
  1624.    end
  1625.    call SayMsg Tstr
  1626.    if pos( Mdm.NoCarrier, Tstr ) = 1 then do
  1627.       Dev.Carrier = G.False
  1628.       call TrcMsg "RxAsyncRead detected a '"Mdm.NoCarrier"' response."
  1629.    end
  1630. Return Tstr
  1631.  
  1632. ComSuck:                               /* Readall from communications device */
  1633.    Procedure expose G. Dev. Mdm. Bbs.
  1634.    Tstr = ""
  1635.    Ttmp = ""
  1636.    Trxc = 0
  1637.    do while Trxc = 0
  1638.       Trxc = RxAsyncRead( Dev.Hdl, 0, Dev.PollTime, "Ttmp", "" )
  1639.       if Trxc > 0 then do
  1640.          call Abort "ComSuck: RxAsyncRead failed, Rc='"Trxc"', Str='"Ttmp"'."
  1641.       end
  1642.       if length(Ttmp) > 0 then do
  1643.          call SayMsg Ttmp
  1644.          Tstr = Ttmp
  1645.       end
  1646.    end
  1647. Return Tstr
  1648.  
  1649. ComWrite:                              /* Write to communications device     */
  1650.    Procedure expose G. Dev. Mdm. Bbs.
  1651.    parse arg Tdelay, Tstr
  1652.    Trem = 0
  1653.    Trxc = RxAsyncWrite( Dev.Hdl, Tdelay, Tstr, "Trem" )
  1654.    if Trxc > 0 then do
  1655.       call Abort "ComWrite: RxAsyncWrite failed, Rc='"Trxc"', Rem='"Trem"'."
  1656.    end
  1657.    if G.NoEcho then
  1658.       call TrcMsg Tstr
  1659.    else do
  1660.       call SayMsg Tstr
  1661.    end
  1662. Return
  1663.  
  1664. ComPriority:                           /* Set process priority               */
  1665.    Procedure expose G. Dev. Mdm. Bbs.
  1666.    parse arg Tclass, Tlevel
  1667.    Trxc = RxAsyncPriority( Tclass, Tlevel )
  1668.    if Trxc <> 0 then do
  1669.       call Abort "ComPriority: RxAsyncPriority failed, Rc='"Trxc"'."
  1670.    end
  1671.    call TrcMsg "RxAsyncPriority set, Class='"Tclass"', Level='"Tlevel"'."
  1672. Return
  1673.  
  1674. ComCarrier:                            /* Determine carrier status           */
  1675.    Procedure expose G. Dev. Mdm. Bbs.
  1676.    Dev.Carrier = G.False
  1677.    Trxc = RxAsyncCarrier( Dev.Hdl, 0 )
  1678.    if Trxc > 0 then do
  1679.       call Abort "ComCarrier: RxAsyncCarrier failed, Rc='"Trxc"'."
  1680.    end
  1681.    if Trxc = 0 then
  1682.       Dev.Carrier = G.True
  1683.    else do
  1684.       call TrcMsg "RxAsyncCarrier indicates carrier was dropped."
  1685.    end
  1686. Return Dev.Carrier
  1687.  
  1688. ComConnect:                            /* Connect to specified service       */
  1689.    Procedure expose G. Dev. Mdm. Bbs.
  1690.    parse arg Tservice, Tphone, Tretries, Tretrywait
  1691.    call SayLog "Dialing '"Tservice"' on '"Tphone"'."G.CrLf
  1692.    Tcount = 0
  1693.    Tagain = G.True
  1694.    do while Tagain
  1695.       Tcount = Tcount + 1
  1696.       call ComWrite 0, Mdm.DialPrefix||Tphone||Mdm.DialSuffix
  1697.       call RxAsyncCarrier Dev.Hdl, Mdm.ConTimeout
  1698.       Tstr = ComRead()
  1699.       if length(Tstr) = 0 then do
  1700.          Tstr = ComRead()              /* In case we missed it first time    */
  1701.       end
  1702.       Tconnected = G.False
  1703.       select
  1704.         when length(Tstr) = 0                 then Tagain = ComHangup()
  1705.         when pos( Mdm.Okay       , Tstr ) = 1 then Tagain = G.False
  1706.         when pos( Mdm.Error      , Tstr ) = 1 then Tagain = G.False
  1707.         when pos( Mdm.NoCarrier  , Tstr ) = 1 then Tconnected = G.False
  1708.         when pos( Mdm.NoConnect0 , Tstr ) = 1 then Tconnected = G.False
  1709.         when pos( Mdm.NoConnect1 , Tstr ) = 1 then Tconnected = G.False
  1710.         when pos( Mdm.NoConnect2 , Tstr ) = 1 then Tconnected = G.False
  1711.         when pos( Mdm.NoConnect3 , Tstr ) = 1 then Tconnected = G.False
  1712.         when pos( Mdm.NoConnect4 , Tstr ) = 1 then Tconnected = G.False
  1713.         when pos( Mdm.NoConnect5 , Tstr ) = 1 then Tconnected = G.False
  1714.         when pos( Mdm.NoConnect6 , Tstr ) = 1 then Tconnected = G.False
  1715.         when pos( Mdm.NoConnect7 , Tstr ) = 1 then Tconnected = G.False
  1716.         when pos( Mdm.NoConnect8 , Tstr ) = 1 then Tconnected = G.False
  1717.         when pos( Mdm.NoConnect9 , Tstr ) = 1 then Tconnected = G.False
  1718.         when pos( Mdm.Connect0   , Tstr ) = 1 then Tconnected = G.True
  1719.         when pos( Mdm.Connect1   , Tstr ) = 1 then Tconnected = G.True
  1720.         when pos( Mdm.Connect2   , Tstr ) = 1 then Tconnected = G.True
  1721.         when pos( Mdm.Connect3   , Tstr ) = 1 then Tconnected = G.True
  1722.         when pos( Mdm.Connect4   , Tstr ) = 1 then Tconnected = G.True
  1723.         when pos( Mdm.Connect5   , Tstr ) = 1 then Tconnected = G.True
  1724.         when pos( Mdm.Connect6   , Tstr ) = 1 then Tconnected = G.True
  1725.         when pos( Mdm.Connect7   , Tstr ) = 1 then Tconnected = G.True
  1726.         when pos( Mdm.Connect8   , Tstr ) = 1 then Tconnected = G.True
  1727.         when pos( Mdm.Connect9   , Tstr ) = 1 then Tconnected = G.True
  1728.         otherwise Tagain = ComHangup()
  1729.       end
  1730.       if Tconnected then do
  1731.          Tagain = G.False
  1732.          if length(Mdm.Online) > 0 then do
  1733.             call ComWrite 0, Mdm.Online||Mdm.Enter
  1734.          end
  1735.          if \ComCarrier() then do
  1736.             Tconnected = G.False
  1737.          end
  1738.       end; else do
  1739.          call SayLog "Unable to make connection, Reason='"Tstr"'."G.CrLf
  1740.          if Tagain then do
  1741.             if Tcount >= Tretries then
  1742.                Tagain = G.False
  1743.             else do
  1744.                call RxAsyncSleep Tretrywait
  1745.                Tstr = ComSuck()
  1746.             end
  1747.          end
  1748.       end
  1749.    end
  1750. Return Tconnected
  1751.  
  1752. ComHangup:                             /* Hangup via close and open          */
  1753.    Procedure expose G. Dev. Mdm. Bbs.
  1754.    Tok = G.False
  1755.    if Dev.Hdl > 0 then do
  1756.       Tdev = Dev.Hdl
  1757.       Dev.Hdl = 0                      /* Prevent repeated call              */
  1758.       Trxc = RxAsyncClose( Tdev )
  1759.       if Trxc <> 0 then do
  1760.          call Abort "ComHangup: RxAsyncClose failed, Rc='"Trxc"'."
  1761.       end
  1762.       call TrcMsg "RxAsyncClose closed the device."
  1763.       Dev.Carrier = G.False            /* Should no longer have it           */
  1764.       call RxAsyncSleep 2000           /* Sleep 2 seconds                    */
  1765.       Tdev = 0
  1766.       Trxc = RxAsyncOpen( Dev.Port, "Tdev" )
  1767.       if Trxc <> 0 then do
  1768.          call Abort "ComHangup: RxAsyncOpen failed, Rc='"Trxc"'."
  1769.       end
  1770.       Dev.Hdl = Tdev
  1771.       call TrcMsg "RxAsyncOpen reopened port "Dev.Port", Handle='"Dev.Hdl"'."
  1772.       Tok = G.True
  1773.    end
  1774. Return Tok
  1775.  
  1776. /*****************************************************************************/
  1777. /* EXTERNAL PROTOCOL ROUTINES ############################################## */
  1778. /*****************************************************************************/
  1779.  
  1780. InitProt:                              /* Set required environment           */
  1781.    Procedure expose G. Dev. Mdm. Bbs.
  1782.    /* Ensure path and dpath set correctly for the M2Zmodem external protocol */
  1783.    G.OldPath  = value("PATH", ,"OS2ENVIRONMENT")
  1784.    G.OldDpath = value("DPATH",,"OS2ENVIRONMENT")
  1785.    G.NewPath  = value("PATH",  G.OldPath||"E:\PROGRAMS\OS2\M2ZMODEM;","OS2ENVIRONMENT")
  1786.    G.NewDPath = value("DPATH",G.OldDPath||"E:\PROGRAMS\OS2\M2ZMODEM;","OS2ENVIRONMENT")
  1787.    G.ProtIni  = G.True
  1788. Return
  1789.  
  1790. FiniProt:                              /* Reset environment                  */
  1791.    Procedure expose G. Dev. Mdm. Bbs.
  1792.    if G.ProtIni then do
  1793.       G.ProtIni  = G.False             /* Prevent repeated call              */
  1794.       G.NewPath  = value("PATH",  G.OldPath,"OS2ENVIRONMENT")
  1795.       G.NewDPath = value("DPATH",G.OldDPath,"OS2ENVIRONMENT")
  1796.    end
  1797. Return
  1798.  
  1799. SendFile:                              /* Upload the specified file          */
  1800.    Procedure expose G. Dev. Mdm. Bbs.
  1801.    parse arg Tprot, Tbaud, Tfname
  1802.    Tprot = translate( Tprot )          /* Convert to uppercase               */
  1803.    if substr(translate(Bbs.FtpStatus),1,1) == "Y" then
  1804.       Tpm = "-pm "
  1805.    else do
  1806.       Tpm = ""
  1807.    end
  1808.    /* default file path only if necessary */
  1809.    Tdir  = RxAsyncFilePathIs( Tfname )
  1810.    Tname = RxAsyncFileNameIs( Tfname )
  1811.    if length( Tdir ) = 0 then do
  1812.       Tdir = G.OutBox
  1813.    end
  1814.    Tfname = Tdir||Tname
  1815.    call SayLog "Uploading file '"Tfname"' using protocol '"Tprot"'."G.CrLf
  1816.    Tbegin = time("E")*1000
  1817.    select
  1818.      when Tprot = 'X' then
  1819.           '@M2ZMODEM -u 'Dev.Hdl' -b 'Tbaud' -h -o 'G.XfrFile' 'Tpm'-prty 2 -q -prot XMODEM -s 'Tfname
  1820.      when Tprot = '1' then
  1821.           '@M2ZMODEM -u 'Dev.Hdl' -b 'Tbaud' -h -o 'G.XfrFile' 'Tpm'-prty 2 -q -prot XMODEM1K -s 'Tfname
  1822.      when Tprot = 'Z' then
  1823.           '@M2ZMODEM -u 'Dev.Hdl' -b 'Tbaud' -h -o 'G.XfrFile' 'Tpm'-prty 2 -q -s 'Tfname
  1824.      otherwise
  1825.           RC = 'Protocol unknown'
  1826.    end
  1827.    Tok = (RC = 0)
  1828.    if \Tok then do
  1829.       call SayLog "Upload failed, Rc='"RC"'."G.CrLf
  1830.       call ComWrite 0, G.CtrlX
  1831.       call ComWrite 0, G.CtrlX
  1832.       call ComWrite 0, G.CtrlX
  1833.       call ComWrite 0, G.CtrlX
  1834.       call ComWrite 0, G.CtrlX
  1835.       call ComWrite 0, G.CtrlX
  1836.    end
  1837.    Ttook = (time("E")*1000) - Tbegin
  1838.    call SayLog 'Upload time was 'trunc(Ttook/60000)' mins 'trunc((Ttook/10)-(trunc(Ttook/60000)*6000))/100' secs.'G.CrLf
  1839. Return Tok
  1840.  
  1841. ReceiveFile:                           /* Download to the specified path     */
  1842.    Procedure expose G. Dev. Mdm. Bbs.
  1843.    parse arg Tprot, Tbaud, Tfname
  1844.    Tprot = translate( Tprot )          /* Convert to uppercase               */
  1845.    if substr(translate(Bbs.FtpStatus),1,1) == "Y" then
  1846.       Tpm = "-pm "
  1847.    else do
  1848.       Tpm = ""
  1849.    end
  1850.    /* default file path only if necessary */
  1851.    Tdir  = RxAsyncFilePathIs( Tfname )
  1852.    Tname = RxAsyncFileNameIs( Tfname )
  1853.    if length( Tdir ) = 0 then do
  1854.       Tdir = G.InBox
  1855.    end
  1856.    Tfname = Tdir||Tname
  1857.    call SayLog "Downloading '"Tname"' to '"Tdir"' using protocol '"Tprot"'."G.CrLf
  1858.    Tbegin = time("E")*1000
  1859.    select
  1860.      when Tprot = 'X' then
  1861.           '@M2ZMODEM -u 'Dev.Hdl' -b 'Tbaud' -h -o 'G.XfrFile' 'Tpm'-prty 2 -q -ren -prot XMODEM -r 'Tfname
  1862.      when Tprot = '1' then
  1863.           '@M2ZMODEM -u 'Dev.Hdl' -b 'Tbaud' -h -o 'G.XfrFile' 'Tpm'-prty 2 -q -ren -prot XMODEM1K -r 'Tfname
  1864.      when Tprot = 'Z' then
  1865.           '@M2ZMODEM -u 'Dev.Hdl' -b 'Tbaud' -h -o 'G.XfrFile' 'Tpm'-prty 2 -q -ren -r 'Tdir
  1866.      otherwise
  1867.           RC = 'Protocol unknown'
  1868.    end
  1869.    Tok = (RC = 0)
  1870.    if \Tok then do
  1871.       call SayLog "Download failed, Rc='"RC"'."G.CrLf
  1872.       call ComWrite 0, G.CtrlX
  1873.       call ComWrite 0, G.CtrlX
  1874.       call ComWrite 0, G.CtrlX
  1875.       call ComWrite 0, G.CtrlX
  1876.       call ComWrite 0, G.CtrlX
  1877.       call ComWrite 0, G.CtrlX
  1878.    end
  1879.    Ttook = (time("E")*1000) - Tbegin
  1880.    call SayLog 'Download time was 'trunc(Ttook/60000)' mins 'trunc((Ttook/10)-(trunc(Ttook/60000)*6000))/100' secs.'G.CrLf
  1881. Return Tok
  1882.  
  1883. /*****************************************************************************/
  1884. /* ABORT AND MESSAGE HANDLING ############################################## */
  1885. /*****************************************************************************/
  1886.  
  1887. SayMsg:                                /* Write output without logging       */
  1888.    Procedure expose G. Dev. Mdm. Bbs.
  1889.    parse arg Tstr
  1890.    if length( Tstr ) > 0 then do
  1891.       if \G.Quietly then call RxAsyncPrint Tstr
  1892.       call WriteTrc Tstr
  1893.       call WriteCap Tstr
  1894.    end
  1895. Return
  1896.  
  1897. SayLog:                                /* Write output with logging          */
  1898.    Procedure expose G. Dev. Mdm. Bbs.
  1899.    parse arg Tstr
  1900.    if length( Tstr ) > 0 then do
  1901.       if \G.Quietly then call RxAsyncPrint Tstr
  1902.       call WriteTrc Tstr
  1903.       call WriteCap Tstr
  1904.       call WriteLog Tstr
  1905.    end
  1906. Return
  1907.  
  1908. TrcMsg:                                /* Write output to trace only         */
  1909.    Procedure expose G. Dev. Mdm. Bbs.
  1910.    parse arg Tstr
  1911.    if length( Tstr ) > 0 then do
  1912.       call WriteTrc Tstr
  1913.    end
  1914. Return
  1915.  
  1916. Abort:                                 /* Display error, cleanup and exit    */
  1917.    Procedure expose G. Dev. Mdm. Bbs.
  1918.    parse arg Tstr
  1919.    if \G.Abort then do
  1920.       call SayLog date('N')||' '||time('C')||" => Error: "||Tstr||G.CrLf
  1921.       G.Abort = G.True                 /* Prevent repeated messages          */
  1922.    end
  1923.    call Cleanup
  1924.    exit
  1925. Return
  1926.  
  1927. /*****************************************************************************/
  1928. /* TRACE FILE ROUTINES ##################################################### */
  1929. /*****************************************************************************/
  1930.  
  1931. OpenTrc:                               /* Open session trace file            */
  1932.    Procedure expose G. Dev. Mdm. Bbs.
  1933.    if G.WantTrc then do
  1934.       G.TrcOpen = G.False
  1935.       /* Clear out trace file, only ever want to trace current session */
  1936.       if RxAsyncFileExists( G.TrcFile ) then do
  1937.          if \RxAsyncFileDelete( G.TrcFile ) then do
  1938.             call Abort "OpenTrc: Unable to clear trace file '"G.TrcFile"'."
  1939.          end
  1940.       end
  1941.       Trxc = lineout( G.TrcFile, "RxScript: Tracing commenced on "date('N')" at "time('C')"." )
  1942.       if Trxc <> 0 then do
  1943.          call Abort "OpenTrc: Could not open trace file '"G.TrcFile"', Rc='"Trxc"'."
  1944.       end
  1945.       G.TrcOpen = G.True
  1946.    end
  1947. Return
  1948.  
  1949. WriteTrc:                              /* Write to session trace file        */
  1950.    Procedure expose G. Dev. Mdm. Bbs.
  1951.    parse arg Tstr
  1952.    if G.TrcOpen then do
  1953.       Tstr = strip( Tstr, 'T', D2C(10) )
  1954.       Tstr = strip( Tstr, 'T', D2C(13) )
  1955.       Trxc = lineout( G.TrcFile, Tstr )
  1956.       if Trxc <> 0 then do
  1957.          call Abort "WriteTrc: Could not write to trace file '"G.TrcFile"', Rc='"Trxc"'."
  1958.       end
  1959.    end
  1960. Return
  1961.  
  1962. CloseTrc:                              /* Close session trace file           */
  1963.    Procedure expose G. Dev. Mdm. Bbs.
  1964.    if G.TrcOpen then do
  1965.       G.TrcOpen = G.False              /* Prevent repeated call              */
  1966.       Trxc = lineout( G.TrcFile )
  1967.       if Trxc <> 0 then do
  1968.          call Abort "CloseTrc: Could not close trace file '"G.TrcFile"', Rc='"Trxc"'."
  1969.       end
  1970.    end
  1971. Return
  1972.  
  1973. /*****************************************************************************/
  1974. /* LOG FILE ROUTINES ####################################################### */
  1975. /*****************************************************************************/
  1976.  
  1977. OpenLog:                               /* Open session log file              */
  1978.    Procedure expose G. Dev. Mdm. Bbs.
  1979.    if G.WantLog then do
  1980.       G.LogOpen = G.False
  1981.       Trxc = lineout( G.LogFile, "--------------------------------------------------------------" )
  1982.       if Trxc <> 0 then do
  1983.          call Abort "OpenLog: Could not open log file '"G.LogFile"', Rc='"Trxc"'."
  1984.       end
  1985.       G.LogOpen = G.True
  1986.    end
  1987. Return
  1988.  
  1989. WriteLog:                              /* Write to session log file          */
  1990.    Procedure expose G. Dev. Mdm. Bbs.
  1991.    parse arg Tstr
  1992.    if G.LogOpen then do
  1993.       Tstr = strip( Tstr, 'T', D2C(10) )
  1994.       Tstr = strip( Tstr, 'T', D2C(13) )
  1995.       Trxc = lineout( G.LogFile, Tstr )
  1996.       if Trxc <> 0 then do
  1997.          call Abort "WriteLog: Could not write to log file '"G.LogFile"', Rc='"Trxc"'."
  1998.       end
  1999.    end
  2000. Return
  2001.  
  2002. CloseLog:                              /* Close session log file             */
  2003.    Procedure expose G. Dev. Mdm. Bbs.
  2004.    if G.LogOpen then do
  2005.       G.LogOpen = G.False              /* Prevent repeated call              */
  2006.       Trxc = lineout( G.LogFile )
  2007.       if Trxc <> 0 then do
  2008.          call Abort "CloseLog: Could not close log file '"G.LogFile"', Rc='"Trxc"'."
  2009.       end
  2010.    end
  2011. Return
  2012.  
  2013. /*****************************************************************************/
  2014. /* CAPTURE FILE ROUTINES ################################################### */
  2015. /*****************************************************************************/
  2016.  
  2017. OpenCap:                               /* Open capture file                  */
  2018.    Procedure expose G. Dev. Mdm. Bbs.
  2019.    parse arg Tfile
  2020.    Tname = RxAsyncFileNameIs( Tfile )
  2021.    if Tname \== "" then do
  2022.       G.CapOpen = G.False
  2023.       Tdir  = RxAsyncFilePathIs( Tfile )
  2024.       if length( Tdir ) = 0 then do
  2025.          Tdir = G.PktBox
  2026.       end
  2027.       Trxc = lineout( Tdir||Tname, "---"date('N')"---"time('C')"----------------------------------------" )
  2028.       if Trxc <> 0 then
  2029.          call Abort "OpenCap: Could not open capture file '"Tdir||Tname"', Rc='"Trxc"'."
  2030.       else do
  2031.          G.CapFile = Tdir||Tname
  2032.          G.CapOpen = G.True
  2033.       end
  2034.    end
  2035. Return
  2036.  
  2037. WriteCap:                              /* Write to capture file              */
  2038.    Procedure expose G. Dev. Mdm. Bbs.
  2039.    parse arg Tstr
  2040.    if G.CapOpen then do
  2041.       Tstr = strip( Tstr, 'T', D2C(10) )
  2042.       Tstr = strip( Tstr, 'T', D2C(13) )
  2043.       Trxc = lineout( G.CapFile, Tstr )
  2044.       if Trxc <> 0 then do
  2045.          call Abort "WriteCap: Could not write to capture file '"G.CapFile"', Rc='"Trxc"'."
  2046.       end
  2047.    end
  2048. Return
  2049.  
  2050. CloseCap:                              /* Close capture file                 */
  2051.    Procedure expose G. Dev. Mdm. Bbs.
  2052.    if G.CapOpen then do
  2053.       G.CapOpen = G.False              /* Prevent repeated call              */
  2054.       Trxc = lineout( G.CapFile )
  2055.       if Trxc <> 0 then do
  2056.          call Abort "CloseCap: Could not close capture file '"G.CapFile"', Rc='"Trxc"'."
  2057.       end
  2058.       G.CapFile = ""
  2059.    end
  2060. Return
  2061.  
  2062. /*****************************************************************************/
  2063. /* END MODULE ############################################################## */
  2064. /*****************************************************************************/
  2065.